批量查询数据位置的问题

dfshm

附件 查询指定数据位置.rar (267.9 KB, 下载次数: 10)

2014-6-9 16:46 上传

点击文件名下载附件

谢谢！

zhaogang1960

ADO+数组请参考：

1. Sub 宏1()
   
2.     Dim cnn As Object, SQL$, i&, j&, m&, t, arr, brr, crr(), MyPath$
   
3.     t = [a1]
   
4.     arr = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
   
5.     ReDim crr(1 To UBound(arr), 1 To 1)
   
6.     MyPath = ThisWorkbook.Path & "\数据"
   
7.     For i = 1 To UBound(arr)
   
8.         f = MyPath & arr(i, 1) & ".xlsx"
   
9.         If Dir(f) <> "" Then
   
10.             m = m + 1
    
11.             If m = 1 Then
    
12.                 Set cnn = CreateObject("adodb.connection")
    
13.                 cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='excel 12.0;hdr=no';Data Source=" & f
    
14.                 SQL = "select * from [Sheet1$a:a]"
    
15.             Else
    
16.                 SQL = "select * from [Excel 12.0;hdr=no;Database=" & f & ";].[Sheet1$a:a]"
    
17.             End If
    
18.             brr = cnn.Execute(SQL).GetRows
    
19.             For j = 0 To UBound(brr, 2)
    
20.                 If brr(0, j) = t Then
    
21.                     crr(i, 1) = "A" & j + 1
    
22.                     Exit For
    
23.                 End If
    
24.             Next
    
25.         End If
    
26.     Next
    
27.     [c1].Resize(i - 1) = crr
    
28.     cnn.Close
    
29.     Set cnn = Nothing
    
30. End Sub
    

复制代码

zhaogang1960

请测试附件
查询指定数据位置.rar (283.59 KB, 下载次数: 17)

2014-6-9 17:00 上传

点击文件名下载附件

LMY123

brr = cnn.Execute(SQL).GetRows