Lê Phát Huy
Thành viên hoạt động
![](/diendan/data/PhoToDanhHieu/gold.gif)
![](/diendan/data/PhoToDanhHieu/gold.gif)
![](/diendan/data/PhoToDanhHieu/gold.gif)
Nếu xét version thì tôi có thể viết trong vòng 325 kí tự (Không kể dấu cách trắng)Vậy thì viết như thế nào cho nó chạy với các máy? Xét version là điều không thể tránh?
Nếu xét version thì tôi có thể viết trong vòng 325 kí tự (Không kể dấu cách trắng)Vậy thì viết như thế nào cho nó chạy với các máy? Xét version là điều không thể tránh?
Hay...xúc tích ngắn gọn ...Bạn chỉ cho cách xử lý Font điNếu không xét vấn đền font thì tôi viết như sau:
PHP:Sub DoVui() With CreateObject("ADODB.Connection") .Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName Sheet2.[a2].CopyFromRecordset .Execute("Select * From [Sheet1$]") End With End Sub
Nếu vậy code ADO cực ngắn...Hóng xem học một tíNếu xét version thì tôi có thể viết trong vòng 325 kí tự (Không kể dấu cách trắng)
Sao mình thử chạy code này mà nó báo lỗi nhỉ?Nếu không xét vấn đền font thì tôi viết như sau:
PHP:Sub DoVui() With CreateObject("ADODB.Connection") .Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName Sheet2.[a2].CopyFromRecordset .Execute("Select * From [Sheet1$]") End With End Sub
Tôi đã thử trên nhiều máy và vẫn ra được kết quả. Không thấy lỗi như bạn.Sao mình thử chạy code này mà nó báo lỗi nhỉ?
View attachment 164095
Vẫn còn nhiều, còn có thể rút gọn được nữa.Nếu xét version thì tôi có thể viết trong vòng 325 kí tự (Không kể dấu cách trắng)
Vẫn còn nhiều, còn có thể rút gọn được nữa.
Sub ADO_DoVui()
Dim v As String
v = Application.Version
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & ";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
Sheet2.[a1].CopyFromRecordset .Execute("Select * From [Sheet1$]")
End With
End Sub
Đây là câu đố hay là câu hỏi vậy bạn?Mình có bài toán này, mong GPE tư vấn giúp mình câu truy vấn để ra được kết quả như trong file đính kèm. Cảm ơn.
View attachment 165692
Chào bạn,Đây là câu đố hay là câu hỏi vậy bạn?
... câu truy vấn của mình dài quá, mình thấy ko tối ưu nên muốn tham khảo thêm các câu truy vấn của các bạn.
Cảm ơn bạn đã góp ý. Vấn đề của mình là truy vấn không tối ưu (chạy rất chậm), dữ liệu có 60 dòng thui mà cũng mất khoảng 1s, 100 dòng mất 2.5s.Đối với lập trình, chuyện tối ưu còn tuỳ theo quan điểm. Bạn muốn câu truy vấn ngắn, hay muốn nó hoạt động hiệu quả về tốc độ hay về tài nguyên, hay muốn nó dễ hiểu dễ sửa.
Riêng quan điểm của tôi, khi viết một câu lệnh truy vấn, dài/ngắn là điều kiện cuối cùng mà tôi trông tới.
Mình đã thay đổi truy vấn, tốc độ được cải thiện rất nhiều rùi (100 dòng dữ liệu mất 0.02s, chỉ thay đổi subquery thành table để join thui mà khác hẳn, hic), vậy bạn nào có nhã hứng tham gia giải bài toán này nha.Mình có bài toán này, mong GPE tư vấn giúp mình câu truy vấn để ra được kết quả như trong file đính kèm. Cảm ơn.
View attachment 165692
Xem lại trong code mà bạn khai báo cái đường dẫn, phải thay đổi từ PSNC.xls sang PSNC.xlsmCác bạn giúp mình xử lý sự cố ADO này ạ: ADO tổng hợp công nợ chạy trên excel 2003 hoàn toàn bình thường, khi mình save as thành đuôi .xlsm thì báo lổi như sau:
The Microsoft Access database engine could not find the object 'PSNC'. Make sure the object exists and that you spell its name and the path name correctly. if 'PSNC' is not a local object, check your network connection or contact the server administator
Mình thử kiểm tra vùng PSNC thấy vẫn tồn tại bình thường, không hiểu sao lại báo lổi như thế
Cám ơn các bạn
2 cách dùng ADO mà tôi biết (có thể có các cách khác tôi không biết)
1. Dùng ADO Exlensions của DDLS (ADOX) để đọc Catalog
Mã:Sub GetSheetNames1() Dim cn As ADODB.Connection Dim cat As ADOX.Catalog Dim t As ADOX.Table Set cn = New ADODB.Connection cn.Open "Provider=MSDASQL.1;Data Source=Excel Files;" _ & "Initial Catalog=C:\Junks\Test Book.xls" Set cat = New ADOX.Catalog Set cat.ActiveConnection = cn For Each t In cat.Tables Debug.Print t.Name Next t Set cat = Nothing cn.Close Set cn = Nothing End Sub
2. Dùng hàm OpenSchema và tham số adSchemaTables để load schema vào một string rồi parse string đó để lấy tên sheet
Mã:Sub GetSheetNames2() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = GetExcelConnection("C:\Junks\Test Book.xls") Set rs = cn.OpenSchema(adSchemaTables) Do While Not rs.EOF strTable = rs.Fields("table_name").Value If Right$(strTable, 1) = "$" Then ' sheet name strWorksheetList = strWorksheetList & vbCrLf & strTable Else ' range name strRangeList = strRangeList & vbCrLf & strTable End If rs.MoveNext Loop Debug.Print "Worksheets:" & strWorksheetList & vbCrLf & vbCrLf & "Ranges:" & strRangeList End Sub Private Function GetExcelConnection(ByVal Path As String, _ Optional ByVal Headers As Boolean = True) As Connection Dim strConn As String Dim objConn As ADODB.Connection Set objConn = New ADODB.Connection strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & Path & ";" & _ "Extended Properties=""Excel 8.0;HDR=" & _ IIf(Headers, "Yes", "No") & """" objConn.Open strConn Set GetExcelConnection = objConn End Function
Cả 2 cách đều lấy tên sheet theo thứ tự abc. Làm thế nào để biết sheet đầu tiên thì tôi lười quá chưa nghĩ ra.
Theo tôi biết, Catalog và Schema đọc tên sheet từ ISAM table cho nên bắt buộc phải theo thứ tự index của ISAM.
Cho em hỏi các anh đánh dấu mục nào trong References để cho code không bị lỗi
Dim cat As ADOX.Catalog
Em xin chân thành cảm ơn
Public Sub Check_ADOX()
Rem Microsoft ADO Ext. 2.8 for DDL and Security
On Error GoTo Thoat
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{00000600-0000-0010-8000-00AA006D2EA4}", Major:=2, Minor:=8
Thoat:
End Sub
Sub LayTenSheet2010()
Dim Dbs As Object, db As Object, tbl As Object
Set Dbs = CreateObject("DAO.DBEngine.36")
Set db = Dbs.OpenDatabase("D:\test.xlsx", False, True, "Excel 12.0;")
For Each tbl In db.TableDefs
If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
MsgBox tbl.Name
End If
Next tbl
db.Close
Set Dbs = Nothing: Set db = Nothing: Set tbl = Nothing
End Sub
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2