[已解决]求大神将A工作表和B工作表的内容合并到C工作表的函数公式或vba代码

tapingyunduan

表格合并.rar (6.34 KB, 下载次数: 14)

2017-4-25 23:02 上传

点击文件名下载附件
表格合并

最佳答案

月排行榜 / 总排行榜

grf1973

2017-4-26 16:33

1. Sub 合并()
   
2.     arr = Sheets(1).[a1].CurrentRegion
   
3.     brr = Sheets(2).[a1].CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 1)) = d(arr(i, 1)) & "," & i
   
8.     Next
   
9.     For i = 2 To UBound(brr)
   
10.         d1(brr(i, 1)) = d1(brr(i, 1)) & "," & i
    
11.     Next
    
12.     ReDim crr(1 To UBound(arr) + UBound(brr), 1 To 5)
    
13.     [a2:e65536].Clear
    
14.     For Each x In d.keys
    
15.         xrr = Split(d(x), ","): n1 = UBound(xrr)
    
16.         yrr = Split(d1(x), ","): n2 = UBound(yrr)
    
17.         nmax = Application.Max(n1, n2)
    
18.         Cells(n + 2, 1).Resize(nmax).Merge
    
19.         Cells(n + 2, 2).Resize(nmax).Merge
    
20.         For k = 1 To nmax
    
21.             n = n + 1
    
22.             If k <= n2 Then
    
23.                 k2 = yrr(k)
    
24.                 crr(n, 1) = brr(k2, 1)
    
25.                 crr(n, 2) = brr(k2, 2)
    
26.                 crr(n, 3) = brr(k2, 3)
    
27.             End If
    
28.             If k <= n1 Then
    
29.                 k1 = xrr(k)
    
30.                 crr(n, 4) = arr(k1, 2)
    
31.                 crr(n, 5) = arr(k1, 3)
    
32.             End If
    
33.         Next
    
34.     Next
    
35.     [a2].Resize(n, 5) = crr
    
36.     [a2].Resize(n, 5).Borders.LineStyle = 1
    
37. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 合并()
   
2.     arr = Sheets(1).[a1].CurrentRegion
   
3.     brr = Sheets(2).[a1].CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 1)) = d(arr(i, 1)) & "," & i
   
8.     Next
   
9.     For i = 2 To UBound(brr)
   
10.         d1(brr(i, 1)) = d1(brr(i, 1)) & "," & i
    
11.     Next
    
12.     ReDim crr(1 To UBound(arr) + UBound(brr), 1 To 5)
    
13.     [a2:e65536].Clear
    
14.     For Each x In d.keys
    
15.         xrr = Split(d(x), ","): n1 = UBound(xrr)
    
16.         yrr = Split(d1(x), ","): n2 = UBound(yrr)
    
17.         nmax = Application.Max(n1, n2)
    
18.         Cells(n + 2, 1).Resize(nmax).Merge
    
19.         Cells(n + 2, 2).Resize(nmax).Merge
    
20.         For k = 1 To nmax
    
21.             n = n + 1
    
22.             If k <= n2 Then
    
23.                 k2 = yrr(k)
    
24.                 crr(n, 1) = brr(k2, 1)
    
25.                 crr(n, 2) = brr(k2, 2)
    
26.                 crr(n, 3) = brr(k2, 3)
    
27.             End If
    
28.             If k <= n1 Then
    
29.                 k1 = xrr(k)
    
30.                 crr(n, 4) = arr(k1, 2)
    
31.                 crr(n, 5) = arr(k1, 3)
    
32.             End If
    
33.         Next
    
34.     Next
    
35.     [a2].Resize(n, 5) = crr
    
36.     [a2].Resize(n, 5).Borders.LineStyle = 1
    
37. End Sub
    

复制代码

tapingyunduan

恩，解决了，很感谢

tapingyunduan

在前面的问题上追加提问：如果A表多加一列，B表多加10列这样的数据，请问大神怎么改代码，新手求教。

雄鹰2013

学习了