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ó đó
Em xin đưa đáp án đầu tiên, anh góp ý nhé
Sub FieldName()
Dim Cn As Object, Rst As Object, LsSql As String, Arr() As Variant
Set Cn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.recordset")
Cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
LsSql = "Select * from [Table]"
Rst.Open LsSql, Cn, 3, 1
Arr = Rst.getrows
ActiveCell.Resize(UBound(Arr, 1) + 1, 1) = Arr
End SubSub ColumName()
Dim Cn As Object, Rst As Object
Set Cn = CreateObject("ADODB.Connection")
Cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
Set Rst = Cn.Execute("Select top 1 * from [Table]")
ActiveCell.CopyFromRecordset Rst
End SubSub Test()
Dim cnn As ADODB.Connection, rst As ADODB.Recordset, s$, arr
s = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=YES"";"
Set cnn = New ADODB.Connection
cnn.Open s
Set rst = cnn.OpenSchema(4)
arr = rst.GetRows(, , 3)
ActiveCell.Resize(UBound(arr, 2) + 2 - Sheets.Count, 1) = Application.Transpose(arr)
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End SubGần được rồi đó, ráng chút nữa đi. Quy định lấy bảng nào trong file chứ không mặc định là bảng đầu tiên.
Sub ColumnName()
Dim cn As Object, ColumnsSchema As Object, arr
Set cn = CreateObject("ADODB.Connection")
Set ColumnsSchema = CreateObject("ADODB.Recordset")
cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";")
Set ColumnsSchema = cn.OpenSchema(4, Array(Null, Null, "'TenSheet$'"))
arr = ColumnsSchema.GetRows(, , "COLUMN_NAME")
ActiveCell.Resize(UBound(arr, 2) - LBound(arr, 2) + 1, _
1).Value = Application.Transpose(arr)
End Sub
Nếu như ví dụ trong đề bài, cột mã là duy nhất và đã sort thì có thể truy vấn:
Sub STT()
Dim cn As Connection, rst As Recordset, s$
Set cn = New Connection
s = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open s
Set rst = New Recordset
s = "select (select count(b.ma) from data b where b.ma<=a.ma) as STT,a.* from data a"
rst.Open s, cn
Range("G2").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cn.Close
Set cn = Nothing
End Sub
Vậy trường hợp cột mã không còn là duy nhất (có các mã giống nhau) HOẶC chưa sort thì kết quả không còn được gọi là đánh số thứ tự nữa.
Sub TestExcel()
Dim cn As New ADODB.Connection
Dim rst As New ADODB.Recordset
cn.Open ("Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};dbq=" & ThisWorkbook.FullName & ";")
rst.Open ("select SUPPLIERS from [Data$] union select SUPPLIERS from [Data$]"), cn
Sheet2.[C2].CopyFromRecordset rst
End Sub
