希望能用VBA高效实现两表合并

duquancai

1. # -*- coding: utf-8 -*-
   
2. # version: Python 3.7.0
   
3. import pandas as pd
   
4. 
   
5. df1 = pd.read_excel('./两表合并1.xlsx',sheet_name='第1张表')
   
6. df2 = pd.read_excel('./两表合并1.xlsx',sheet_name='第2张表')
   
7. df = pd.merge(df2,df1,how='outer',on='关联字段')
   

复制代码

lwwy1981

精简了一下无用的判断,速度又提升25%

1. 
   
2. Sub 双表合并()
   
3.     'On Error Resume Next
   
4.     t = Timer
   
5.     Set d_left = CreateObject("scripting.dictionary")   '左侧表头
   
6.     Set d_top = CreateObject("scripting.dictionary")    '上部表头
   
7.     Set d = CreateObject("scripting.dictionary")        '数据字典
   
8.     arr_1 = Sheets("第1张表").[A1].CurrentRegion
   
9.     arr_2 = Sheets("第2张表").[A1].CurrentRegion
   
10.     '''左侧表头装入字典
    
11.     For i = 1 To UBound(arr_1)
    
12.         d_left(arr_1(i, 1)) = ""
    
13.     Next i
    
14.     For i = 1 To UBound(arr_2)
    
15.         d_left(arr_2(i, 1)) = ""
    
16.     Next i
    
17.     '''头部表头装入字典
    
18.     For j = 1 To UBound(arr_1, 2)
    
19.         d_top(arr_1(1, j)) = ""
    
20.     Next j
    
21.     For j = 1 To UBound(arr_2, 2)
    
22.         d_top(arr_2(1, j)) = ""
    
23.     Next j
    
24.     ''数据部分装入到字典
    
25.     For i = 2 To UBound(arr_1)
    
26.         For j = 2 To UBound(arr_1, 2)
    
27.             d(arr_1(i, 1) & "-" & arr_1(1, j)) = arr_1(i, j)
    
28.         Next j
    
29.     Next i
    
30.     For i = 2 To UBound(arr_2)
    
31.         For j = 2 To UBound(arr_2, 2)
    
32.             d(arr_2(i, 1) & "-" & arr_2(1, j)) = arr_2(i, j)
    
33.         Next j
    
34.     Next i
    
35.     ''输出到数组brr
    
36.     ReDim brr(1 To d_left.Count, 1 To d_top.Count)
    
37.     For i = 1 To UBound(brr)
    
38.         For j = 1 To UBound(brr, 2)
    
39.             If i = 1 Then brr(i, j) = d_top.Keys()(j - 1)
    
40.             If j = 1 Then brr(i, j) = d_left.Keys()(i - 1)
    
41.             If i > 1 And j > 1 Then
    
42.                 brr(i, j) = d(brr(i, 1) & "-" & brr(1, j))
    
43.             End If
    
44.         Next j
    
45.     Next i
    
46.     With Sheets("合并后结果")
    
47.         .Cells.Clear
    
48.         .Range(Cells(1, 1), Cells(UBound(brr), UBound(brr, 2))) = brr
    
49.     End With
    
50.     MsgBox "运行完毕,用时" & Timer - t
    
51. End Sub

复制代码

lwwy1981

shi353 发表于 2020-6-14 21:17
速度很慢大概要半分鐘,但是還是可以獲得結果吧!
Sub sh1()
Sheet4.Activate

参考一下我的思路,12楼,   6万+6万数据只需要1.7秒

lrh788

lwwy1981 发表于 2020-6-14 21:47
参考一下我的思路,12楼,   6万+6万数据只需要1.7秒

老师，如果有很多分表，能否改进代码自动识分表进行合并汇总。
另外，请老师帮我写下代码http://club.excelhome.net/thread-1542088-1-1.html

lwwy1981

lrh788 发表于 2020-6-14 21:54
老师，如果有很多分表，能否改进代码自动识分表进行合并汇总。
另外，请老师帮我写下代码http://club.ex ...

原理是一样的,你看我的代码按自己的要求修改一下就可以,你的表有合并单元格,在装入字典之前先拆分单元格处理一下就可以了

lrh788

老师，我是菜鸟，还请老师帮我写下完整版的代码，且考虑到有很多分表的通用代码！因我的实际工作中有100多个分表

LighOffice

这个帖子应该有用http://club.excelhome.net/forum.php?mod=viewthread&tid=1541567

jshamj

microyip 发表于 2020-6-14 12:29
附上附件以供参考

虽然不能理解，还是非常感谢

jshamj

lwwy1981 发表于 2020-6-14 17:37
两个表都是2000行*30列的数据

要的就是这个效果，感谢lwwy1981老师的解答。

jshamj

lwwy1981 发表于 2020-6-14 21:45
精简了一下无用的判断,速度又提升25%

使用这个程序时，要注意两表的表头除关联字段外，字段名不能重名，如果重名，优先取得“第2张表”的数据。