|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
ADO法速度很快,请参考:
- Sub ADO加数组法()
- Dim Fso As Object, File As Object, cnn As Object, SQL$, i&, m&, c, arr, brr(), d As Object
- Set d = CreateObject("scripting.dictionary")
- Set Fso = CreateObject("scripting.filesystemobject")
- arr = Range("A1").CurrentRegion
- For i = 2 To UBound(arr, 2)
- d(arr(2, i)) = i
- Next
- myPath = ThisWorkbook.Path
- ReDim brr(1 To Fso.GetFolder(myPath).Files.Count, 1 To i - 1)
- Set cnn = CreateObject("ADODB.Connection")
- For Each File In Fso.GetFolder(myPath).Files
- If File.Name Like "*.xlsx" Then
- m = m + 1
- If m = 1 Then
- cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & File
- SQL = "SELECT * FROM [Sheet1$B2:I3]"
- Else
- SQL = "SELECT * FROM [Excel 12.0;hdr=no;Database=" & File & "].[Sheet1$B2:I3]"
- End If
- arr = cnn.Execute(SQL).GetRows
- brr(m, 1) = Replace(File.Name, ".xlsx", "")
- For i = 0 To UBound(arr)
- c = d(arr(i, 0))
- If c <> "" Then brr(m, c) = arr(i, 1)
- Next
- End If
- Next
- ActiveSheet.UsedRange.Offset(2).ClearContents
- Range("a3").Resize(m, UBound(brr, 2)) = brr
- Set Fso = Nothing
- cnn.Close
- Set cnn = Nothing
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|