合并工作表-匹配字段

胡说V八道

先收藏了！

cjc209

瞬间完成 单表动态字段合并成一表

1. Sub 动态字段单薄多表合并为一表()
   
2.     Dim d, ar, br, sh As Worksheet
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     For Each sh In Sheets
   
6.        qsl = sh.UsedRange.Column
   
7.        qsh = sh.UsedRange.Row
   
8.        zdh = sh.Cells(65536, qsl).End(xlUp).Row
   
9.         If sh.Name <> ActiveSheet.Name Then
   
10.          If zdh > 1 Then
    
11.             ar = sh.Cells(qsh, qsl).CurrentRegion
    
12.             For i = 1 To UBound(ar, 2)
    
13.                 d(ar(1, i)) = 0
    
14.             Next
    
15.          End If
    
16.         End If
    
17.     Next
    
18.     ReDim br(1 To 60000, 1 To d.Count): m = 1
    
19.     For i = 1 To d.Count
    
20.         d(d.keys()(i - 1)) = i
    
21.         br(1, i) = d.keys()(i - 1)
    
22.     Next
    
23.     For Each sh In Sheets
    
24.        qsl = sh.UsedRange.Column
    
25.        qsh = sh.UsedRange.Row
    
26.        zdh = sh.Cells(65536, qsl).End(xlUp).Row
    
27.         If sh.Name <> ActiveSheet.Name Then
    
28.          If zdh > 1 Then
    
29.             ar = sh.Cells(qsh, qsl).CurrentRegion
    
30.             For i = 2 To UBound(ar)
    
31.                 m = m + 1
    
32.                 For j = 1 To UBound(ar, 2)
    
33.                     br(m, d(ar(1, j))) = ar(i, j)
    
34.                 Next
    
35.             Next
    
36.             End If
    
37.         End If
    
38.     Next
    
39.     With ActiveSheet
    
40.         .UsedRange.ClearContents
    
41.         .[a1].Resize(m, UBound(br, 2)) = br
    
42.     End With
    
43.     Application.ScreenUpdating = True
    
44. End Sub
    

复制代码

jjmysjg

cjc209 发表于 2018-10-1 22:15
瞬间完成 单表动态字段合并成一表

代码提取不重复字段，方便