Sub getnames()
Dim cnn As New ADODB.Connection
Dim XLName As String
Dim rs As New ADODB.Recordset
Dim Arr As Variant
Dim cArr As Variant
Dim rsArr As Variant
Dim lc As String
Dim destRG As String
XLName = "D:\\myfile.xlsx"
Application.ScreenUpdating = False
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source='" & XLName & "';" & _
"Extended Properties=""Excel 12.0;"""
.Open
End With
Set rs = cnn.OpenSchema(adSchemaTables)
Arr = rs.GetRows
lc = Split(Cells(1, UBound(Arr, 2) + 1).Address(True, False), "$")(0)
destRG = "A1:" & lc & (UBound(Arr) + 1)
Sheet1.Range(destRG).Value = Arr
cArr = Sheet1.Range(destRG).Value
Sheet1.Range(destRG).ClearContents
rsArr = WorksheetFunction.Index(cArr, 3)
Sheet1.Range("A1:A" & UBound(rsArr)).Value = WorksheetFunction.Transpose(rsArr)
Sheet1.Range("A1:A" & UBound(rsArr)).Replace "$", ""
rs.Close
cnn.Close
Application.ScreenUpdating = True
End Subcho góp vui cách của dân mù VBA
Mã:Sub getnames() Dim cnn As New ADODB.Connection Dim XLName As String Dim rs As New ADODB.Recordset Dim Arr As Variant Dim cArr As Variant Dim rsArr As Variant Dim lc As String Dim destRG As String XLName = "D:\\myfile.xlsx" Application.ScreenUpdating = False With cnn .Provider = "Microsoft.ACE.OLEDB.12.0" .ConnectionString = "Data Source='" & XLName & "';" & _ "Extended Properties=""Excel 12.0;""" .Open End With Set rs = cnn.OpenSchema(adSchemaTables) Arr = rs.GetRows lc = Split(Cells(1, UBound(Arr, 2) + 1).Address(True, False), "$")(0) destRG = "A1:" & lc & (UBound(Arr) + 1) Sheet1.Range(destRG).Value = Arr cArr = Sheet1.Range(destRG).Value Sheet1.Range(destRG).ClearContents rsArr = WorksheetFunction.Index(cArr, 3) Sheet1.Range("A1:A" & UBound(rsArr)).Value = WorksheetFunction.Transpose(rsArr) Sheet1.Range("A1:A" & UBound(rsArr)).Replace "$", "" rs.Close cnn.Close Application.ScreenUpdating = True End Sub
. Nhờ anh chỉ giáo vậy .
anh nói thế thì em như "vịt nghe sấm "
Không biết khi chạy code có cần kích hoạt ADO không nhỉ?
Không biết là bạn đã tìm ra giải pháp chưa?anh nói thế thì em như "vịt nghe sấm "
dân mù VBA mà anh . có những cái em ko tự giải thích đc . thí dụ như
đối với file excel nhẹ : truy vấn luôn tìm đc vùng có filter
đối với file excel nặng , như file công ty em 15mb : truy vấn này không thể tìm đc vùng có filter , nhưng nếu truy vấn khi file đó đang mở bằng cửa sổ application thì truy vấn lại tìm ra
đâu là sự khác nhau giữa chúng ? mong anh giải đáp giúp
Sub TableName()
Dim Cn As Object, rsTables As Object, Arr() As Variant
Set Cn = CreateObject("ADODB.Connection")
Cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0"";")
Set rsTables = Cn.OpenSchema(20)
Arr = rsTables.GetRows(, , "TABLE_NAME")
ActiveCell.Resize(UBound(Arr, 2) - LBound(Arr, 2) + 1, 1).Value = Application.Transpose(Arr)
End SubEm nghĩ chắc tại các thành viên trên GPE ít người biết về ADO nên không có câu trả lời ạ!
Hihi, ADO nó chỉ làm việc với dữ liệu rõ ràng, mà rõ ràng là dữ liệu phải được tồn tại trong đĩa cứng. Nếu file chưa lưu hoặc file mới sẽ bị vấn đề.Bài này dễ ồm... nếu tui có học qua Access, SQL, ADO...
Hổng học, biết chết liền!
Ẹc... Ẹc...
---------------------------
Phát hiện 1 chiện: Code chỉ đúng với file đã lưu, có tên đàng hoàng. Còn với file mới tinh vừa tạo chưa lưu thì.. trật lất!
không phải là người ta không biết đâu bạn, mà ADO đối với excel không mạnh bằng các ngôn ngữ khác chẳng hạn SQL, ACCESS, oracle, ..., ADO chẳng qua nó là công cụ giúp bạn thao tác trên các bảng với dữ liệu thông qua các phép kết.
Đúng là như anh nói, với công nghệ kéo thả hiện nay có thể giúp chúng ta viết các câu truy vấn phức tạp(nhưng không phải là tât cả), giúp chúng ta làm được những việc mà chúng ta cần mặc dù chúng ta không hiểu nguyên lý tại sao ra như vậy? nhưng học như vậy muốn phát triển thêm thì hơi bị khó đó
