vba批量汇总求和（多条件匹配多工作簿多列多条件分列求和）

he_zai

模仿vlookup实现多条件匹配
效果图：
数据源
年金数据源
要求：根据身份号+正常应缴（正常补收）查找所有工作簿并复制到相应行、列
现缺点：失业数据源，有一些名字是两行数据，一行是零，要排序后才能匹配第一个，希望大神再改进为，失业、工伤的值条件相同的话   相加
代码
重复的情况有两种，
1-养老，年金，医疗，重复身份证号码为一行是正常应缴，一行是正常补收
2-失业工作簿里面，情况除上面的外，还有工伤列，有些和失业列一行，有些不在同一行，所以这个工作簿想同的身份证号码可以有四行（正常应缴2行），（正常补收2行），因此这工作簿的，同身份证号码，同正常应缴或者正常补收，应为累加（求和）

1. Sub 快速匹配()    '子程序 byWanao()
   
2. Dim arr, brr(), sht As Worksheet, WB As Workbook, shtt As Worksheet    '定义变量 arr,brr(),sht 为 工作表,WB 为 工作簿,shtt 为 工作表
   
3. Dim 年金 As String, 养老 As String, 医疗 As String, 失业 As String    '定义变量 年金 为 字符串,养老 为 字符串,医疗 为 字符串,失业 为 字符串
   
4. 年金 = "202304 征集明细 年金"    ' 年金="202304征集明细年金"
   
5. 养老 = "202304 征集明细 养老"    '养老="202304征集明细养老"
   
6. 失业 = "202304 征集明细 失业"    '失业="202304征集明细失业"
   
7. 医疗 = "单位参保职工缴费明细"    '医疗="单位参保职工缴费明细"
   
8. ThisWorkbook.Sheets("Sheet1").[e2:h426].ClearContents    '<当前工作簿>的<工作表>"Sheet1" )的[e2 :h426]的清除内容
   
9. ThisWorkbook.Sheets("Sheet1").[k2:n426].ClearContents    '<当前工作簿>的<工作表>"Sheet1" )的[k2 :n426]的清除内容
   
10. Path = ThisWorkbook.Path & "\扣款明细源"    '路径= 当前工作簿的路径 & "\扣款明细源"
    
11. Filename = Dir(Path & "*.xls", vbDirectory)    ' 文件名=<查找文件或目录>(路径 & "*.xls",vbDirectory)
    
12. Do    '执行循环操作
    
13.     If Len(Filename) = 0 Then Exit Do    '如果 <字符串长度值>( 文件名)=0 则执行 退出执行循环操作
    
14.     Set sht = ThisWorkbook.Sheets("Sheet1")    '设定sht=<当前工作簿>的<工作表>"Sheet1")
    
15.     Set WB = Workbooks.Open(Path & Filename)    '设定WB= 工作簿集合的Open(路径 &  文件名)
    
16.     Application.ScreenUpdating = False    '关闭屏幕刷新(可以提高运行速度)
    
17.     For Each shtt In WB.Sheets    '设定变量范围为每一个shtt位于 WB的表单集合
    
18.         If shtt.Name = 年金 Then    '如果  shtt的名称=年金 则执行
    
19.             With Sheets(年金)    '工作于<工作表>(年金)
    
20.                 For i = 2 To sht.Cells(Rows.Count, 1).End(xlUp).Row    '设定变量范围为i=2到 sht的<单元格>坐标(行数值,1 )的<末端>(方向向上 )的行标
    
21.                     For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row    '设定变量范围为j=2到<With对象>的<单元格>坐标(行数值,1 )的<末端>(方向向上 )的行标
    
22.                         If sht.Cells(i, 3) & "正常应缴" = .Cells(j, 6) & .Cells(j, 7) Then    '如果  sht的<单元格>坐标(i,3) & "正常应缴"=<With对象>的<单元格>坐标(j,6) & <With对象>的<单元格>坐标(j,7) 则执行
    
23.                             sht.Cells(i, 6) = .Cells(j, 16)    ' sht的<单元格>坐标(i,6)=<With对象>的<单元格>坐标(j,16)
    
24.                         ElseIf sht.Cells(i, 3) & "正常补收" = .Cells(j, 6) & .Cells(j, 7) Then    '另外如果 sht的<单元格>坐标(i,3) & "正常补收"=<With对象>的<单元格>坐标(j,6) & <With对象>的<单元格>坐标(j,7) 则执行
    
25.                             sht.Cells(i, 12) = .Cells(j, 16)    ' sht的<单元格>坐标(i,12)=<With对象>的<单元格>坐标(j,16)
    
26.                             Exit For    '退出for循环
    
27.                         Else    '另外
    
28.                         End If    'If判断过程结束
    
29.                     Next    '下一个
    
30.                 Next    '下一个
    
31.             End With    'With语句结束
    
32.         End If    'If判断过程结束
    
33.         If shtt.Name = 养老 Then    '如果  shtt的名称=养老 则执行
    
34.             With Sheets(养老)    '工作于<工作表>(养老)
    
35.                 For i = 2 To sht.Range("A10000").End(xlUp).Row    '设定变量范围为i=2到 sht的<单元格>区域("A10000" )的<末端>(方向向上 )的行标
    
36.                     For j = 2 To .Range("A10000").End(xlUp).Row    '设定变量范围为j=2到<With对象>的<单元格>区域("A10000" )的<末端>(方向向上 )的行标
    
37.                         If sht.Cells(i, 3) & "正常应缴" = .Cells(j, 6) & .Cells(j, 7) Then    '如果  sht的<单元格>坐标(i,3) & "正常应缴"=<With对象>的<单元格>坐标(j,6) & <With对象>的<单元格>坐标(j,7) 则执行
    
38.                             sht.Cells(i, 5) = .Cells(j, 12)    ' sht的<单元格>坐标(i,5)=<With对象>的<单元格>坐标(j,12)
    
39.                         ElseIf sht.Cells(i, 3) & "正常补收" = .Cells(j, 6) & .Cells(j, 7) Then    '另外如果 sht的<单元格>坐标(i,3) & "正常补收"=<With对象>的<单元格>坐标(j,6) & <With对象>的<单元格>坐标(j,7) 则执行
    
40.                             sht.Cells(i, 11) = .Cells(j, 12)    ' sht的<单元格>坐标(i,11)=<With对象>的<单元格>坐标(j,12)
    
41.                             Exit For    '退出for循环
    
42.                         Else    '另外
    
43.                         End If    'If判断过程结束
    
44.                     Next    '下一个
    
45.                 Next    '下一个
    
46.             End With    'With语句结束
    
47.         End If    'If判断过程结束
    
48.         If shtt.Name = 失业 Then    '如果  shtt的名称=失业 则执行
    
49.             With Sheets(失业)    '工作于<工作表>(失业)
    
50.                 Range("a1:ad1000").Sort Range("x2"), xlAscending    '<单元格>区域("a1:ad1000" )的排序 <单元格>区域("x2"),升序
    
51.                 For i = 2 To sht.Cells(Rows.Count, 1).End(xlUp).Row    '设定变量范围为i=2到 sht的<单元格>坐标(行数值,1 )的<末端>(方向向上 )的行标
    
52.                     For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row    '设定变量范围为j=2到<With对象>的<单元格>坐标(行数值,1 )的<末端>(方向向上 )的行标
    
53.                         If sht.Cells(i, 3) & "正常应缴" = .Cells(j, 6) & .Cells(j, 7) Then    '如果  sht的<单元格>坐标(i,3) & "正常应缴"=<With对象>的<单元格>坐标(j,6) & <With对象>的<单元格>坐标(j,7) 则执行
    
54.                             sht.Cells(i, 7) = .Cells(j, 24)    ' sht的<单元格>坐标(i,7)=<With对象>的<单元格>坐标(j,24)
    
55.                         ElseIf sht.Cells(i, 3) & "正常补收" = .Cells(j, 6) & .Cells(j, 7) Then    '另外如果 sht的<单元格>坐标(i,3) & "正常补收"=<With对象>的<单元格>坐标(j,6) & <With对象>的<单元格>坐标(j,7) 则执行
    
56.                             sht.Cells(i, 13) = .Cells(j, 24)    ' sht的<单元格>坐标(i,13)=<With对象>的<单元格>坐标(j,24)
    
57.                             Exit For    '退出for循环
    
58.                         Else    '另外
    
59.                         End If    'If判断过程结束
    
60.                     Next    '下一个
    
61.                 Next    '下一个
    
62.             End With    'With语句结束
    
63.         End If    'If判断过程结束
    
64.         If shtt.Name = 医疗 Then    '如果  shtt的名称=医疗 则执行
    
65.             With Sheets(医疗)    '工作于<工作表>(医疗)
    
66.                 For i = 2 To sht.Cells(Rows.Count, 1).End(xlUp).Row    '设定变量范围为i=2到 sht的<单元格>坐标(行数值,1 )的<末端>(方向向上 )的行标
    
67.                     For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row    '设定变量范围为j=2到<With对象>的<单元格>坐标(行数值,1 )的<末端>(方向向上 )的行标
    
68.                         If sht.Cells(i, 3) & "正常应缴" = .Cells(j, 4) & .Cells(j, 10) Then    '如果  sht的<单元格>坐标(i,3) & "正常应缴"=<With对象>的<单元格>坐标(j,4) & <With对象>的<单元格>坐标(j,10) 则执行
    
69.                             sht.Cells(i, 8) = .Cells(j, 13)    ' sht的<单元格>坐标(i,8)=<With对象>的<单元格>坐标(j,13)
    
70.                         ElseIf sht.Cells(i, 3) & "正常补收" = .Cells(j, 4) & .Cells(j, 10) Then    '另外如果 sht的<单元格>坐标(i,3) & "正常补收"=<With对象>的<单元格>坐标(j,4) & <With对象>的<单元格>坐标(j,10) 则执行
    
71.                             sht.Cells(i, 14) = .Cells(j, 13)    ' sht的<单元格>坐标(i,14)=<With对象>的<单元格>坐标(j,13)
    
72.                             Exit For    '退出for循环
    
73.                         Else    '另外
    
74.                         End If    'If判断过程结束
    
75.                     Next    '下一个
    
76.                 Next    '下一个
    
77.             End With    'With语句结束
    
78.         End If    'If判断过程结束
    
79.     Next    '下一个
    
80.     WB.Close False    ' WB的关闭 False
    
81.     Filename = Dir()    ' 文件名=<查找文件或目录>()
    
82. Loop    '循环执行
    
83. End Sub    '子程序结束
    
84. 
    
85. 
    

复制代码

he_zai

样表格里面的姓名，身份证号码全部随机生成

zpy2

失业数据源，有一些名字是两行数据，一行是零，要排序后才能匹配第一个，


数据来源能否行数少些？没发现你提到的情况

he_zai

zpy2 发表于 2023-4-7 20:34
失业数据源，有一些名字是两行数据，一行是零，要排序后才能匹配第一个，

那应该是随机生成名字或者身份证号时，忘记设计重复了
重复的情况有两种，
1-养老，年金，医疗，重复身份证号码为一行是正常应缴，一行是正常补收
2-失业工作簿里面，情况除上面的外，还有工伤列，有些和失业列一行，有些不在同一行，所以这个工作簿想同的身份证号码可以有四行（正常应缴2行），（正常补收2行），因此这工作簿的，同身份证号码，同正常应缴或者正常补收，应为累加（求和）

he_zai

加油＾０＾~。