多表多条件汇总

jc847860351

求助高手：
             要求见附件--工作表--库存汇总表

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("库存汇总表")
   
7.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
8.     arr = .Range("b3:d" & r)
   
9.     ReDim brr(1 To UBound(arr), 1 To 1)
   
10.     For i = 1 To UBound(arr)
    
11.       xm = arr(i, 1) & "+" & arr(i, 3)
    
12.       d(xm) = i
    
13.     Next
    
14.   End With
    
15.   For Each ws In Worksheets(Array("入库流水账", "出库流水账"))
    
16.     With ws
    
17.       r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
18.       arr = .Range("b3:f" & r)
    
19.       For i = 1 To UBound(arr)
    
20.         xm = arr(i, 2) & "+" & arr(i, 5)
    
21.         If d.exists(xm) Then
    
22.           m = d(xm)
    
23.           brr(m, 1) = brr(m, 1) + IIf(ws.Name = "入库流水账", 1, -1) * arr(i, 4)
    
24.         End If
    
25.       Next
    
26.     End With
    
27.   Next
    
28.   With Worksheets("库存汇总表")
    
29.     .Range("e3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
30.   End With
    
31. End Sub
    

复制代码

chxw68

详见附件。

jc847860351

chxw68 发表于 2018-7-18 12:01

非常好，已达到要求，谢谢。在参考学习