求助：将不同表中对应编号的信息批量汇总在一张表中

wormofsky2012

需求：将不同表中对应编号的信息批量汇总在一张表中。

例：将CU-2.1.1和CU-2.1.2两张表中编号字段与汇总表中编号字段对照，相符则取后面“姓名”和“类型”两个字段内容。

详见附件，谢谢！

编织结艺

将jCU-2.1.1和CU-2.1.2两张表合二为一，再根据汇总表中编号用vlookup取数

wormofsky2012

非常感谢！可现实中有数百张表，如何处理呢

zhaogang1960

请测试

1. Sub 宏1()
   
2.     Dim cnn As Object, SQL$, MyPath$, MyFile$, m&, n&, t$
   
3.     Dim arr, brr(), d As Object, i&, j&, r
   
4.     Application.ScreenUpdating = False
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     arr = Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row)
   
7.     For i = 1 To UBound(arr)
   
8.         d(arr(i, 1)) = i
   
9.     Next
   
10.     ReDim brr(1 To i - 1, 1 To 2)
    
11.     ActiveSheet.UsedRange.Offset(1, 1).ClearContents
    
12.     Set cnn = CreateObject("adodb.connection")
    
13.     MyPath = ThisWorkbook.Path & ""
    
14.     MyFile = Dir(MyPath & "*.xlsx")
    
15.     Do While MyFile <> ""
    
16.         n = n + 1
    
17.         If n = 1 Then
    
18.             cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & MyPath & MyFile
    
19.         Else
    
20.             t = "[Excel 12.0;Database=" & MyPath & MyFile & "]."
    
21.         End If
    
22.         m = m + 1
    
23.         If m > 49 Then
    
24.             arr = cnn.Execute(SQL).getrows
    
25.             For i = 0 To UBound(arr, 2)
    
26.                 r = d(arr(0, i))
    
27.                 If r <> "" Then
    
28.                     For j = 1 To 2
    
29.                         brr(r, j) = arr(j, i)
    
30.                     Next
    
31.                 End If
    
32.             Next
    
33.             m = 1
    
34.             SQL = ""
    
35.         End If
    
36.         If Len(SQL) Then SQL = SQL & " union all "
    
37.         SQL = SQL & "select * from " & t & "[Sheet1$]"
    
38.         MyFile = Dir()
    
39.     Loop
    
40.     If Len(SQL) Then
    
41.         arr = cnn.Execute(SQL).getrows
    
42.         For i = 0 To UBound(arr, 2)
    
43.             r = d(arr(0, i))
    
44.             If r <> "" Then
    
45.                 For j = 1 To 2
    
46.                     brr(r, j) = arr(j, i)
    
47.                 Next
    
48.             End If
    
49.         Next
    
50.     End If
    
51.     Range("b2").Resize(UBound(brr), 2) = brr
    
52.     cnn.Close
    
53.     Set cnn = Nothing
    
54.     Application.ScreenUpdating = True
    
55. End Sub
    

复制代码

zhaogang1960

请看附件
将不同表中对应编号的信息批量汇总在一张表中.rar (29.93 KB, 下载次数: 23)

2012-8-29 17:38 上传

点击文件名下载附件

wormofsky2012

非常感谢！我研究一下。

LMY123

ADO+字典，同夹多薄指定表
r = d(arr(0, i))