VBA实现SUMIF函数跨表汇总

搬砖玄武

quqiyuan 发表于 2024-7-29 22:21
发附件才能看看怎么帮你处理呢

附件已发

quqiyuan

参与一下，仅供参考。。。

quqiyuan

我这个使用了目录的A列，C列作为关键字，入库出库的C列、E列，跟你要求感觉不一样，不知道你实际，否则重复的蛮多的。

ykcbf1100

搬砖玄武 发表于 2024-7-30 12:19
不好意思，第一次使用不知道，已更改

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.7.30
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("入库")
   
5.         r = .Cells(Rows.Count, 3).End(3).Row
   
6.         arr = .[a1].Resize(r, 6)
   
7.         For i = 2 To UBound(arr)
   
8.             s = arr(i, 3) & .Name
   
9.             d(s) = d(s) + Val(arr(i, 6))
   
10.         Next
    
11.     End With
    
12.     With Sheets("出库")
    
13.         r = .Cells(Rows.Count, 3).End(3).Row
    
14.         arr = .[a1].Resize(r, 6)
    
15.         For i = 2 To UBound(arr)
    
16.             s = arr(i, 3) & .Name
    
17.             d(s) = d(s) + Val(arr(i, 6))
    
18.         Next
    
19.     End With
    
20.     With Sheets("目录")
    
21.         r = .Cells(Rows.Count, 1).End(3).Row
    
22.         .[f2:h10000] = ""
    
23.         arr = .[a1].Resize(r, 8)
    
24.         For i = 2 To r
    
25.             For j = 6 To 7
    
26.                 s = arr(i, 1) & arr(1, j)
    
27.                 If d.exists(s) Then
    
28.                     arr(i, j) = d(s)
    
29.                 End If
    
30.             Next
    
31.             arr(i, 8) = arr(i, 6) - arr(i, 7)
    
32.         Next
    
33.         .[a1].Resize(r, 8) = arr
    
34.     End With
    
35.     Set d = Nothing
    
36.     Application.ScreenUpdating = True
    
37.     MsgBox "OK！"
    
38. End Sub
    

复制代码

心的启点

试试这个，测试后反馈！
新建 XLSX 工作表.rar (120.78 KB, 下载次数: 3)

2024-7-30 14:13 上传

点击文件名下载附件