数据汇总减汇总等于结存

chxw68

ykcbf1100 发表于 2024-7-21 11:39
你用chxw68老师的代码好了，他写得比我好。

过谦了！！！

ykcbf1100

7993708 发表于 2024-7-21 01:01
首先感谢老师的付出. 有时候左边没收货,但是右边有可能已经先送货了,所以有时左边没有的产品,右边 ...

我还是改一下吧，就当完成作业，数据不管左多还是右多，都能适应。

ykcbf1100

改一下，以适应可能的

1. Sub ykcbf()   '//2024.7.21
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set d1 = CreateObject("Scripting.Dictionary")
   
4.     Set d2 = CreateObject("Scripting.Dictionary")
   
5.     r1 = Cells(Rows.Count, 2).End(3).Row
   
6.     r2 = Cells(Rows.Count, 10).End(3).Row
   
7.     Max = IIf(r1 < r2, r2, r1) + 2
   
8.     Cells(Max, 1).Resize(23 - Max, 18).ClearContents
   
9.     For i = 10 To Max - 2
   
10.         If Cells(i, 3) <> Empty Then
    
11.             s = UCase(Cells(i, 3)) & "|" & UCase(Cells(i, 4))
    
12.             d(s) = ""
    
13.             d1(s) = d1(s) + Cells(i, 5)
    
14.         End If
    
15.         If Cells(i, 11) <> Empty Then
    
16.             s = UCase(Cells(i, 11)) & "|" & UCase(Cells(i, 12))
    
17.             d(s) = ""
    
18.             d2(s) = d2(s) + Cells(i, 13)
    
19.         End If
    
20.     Next
    
21.     ReDim brr(1 To d.Count, 1 To 3)
    
22.     For Each k In d.keys
    
23.         m = m + 1
    
24.         brr(m, 1) = Split(k, "|")(0)
    
25.         brr(m, 2) = Split(k, "|")(1)
    
26.         brr(m, 3) = d(k)
    
27.     Next
    
28.     If m > 5 Then
    
29.         For i = 1 To m - 5
    
30.             Cells(Max + i, 1).EntireRow.Insert
    
31.         Next i
    
32.     End If
    
33.     Cells(Max, 3).Resize(m, 3) = brr
    
34.     Cells(Max, 11).Resize(m, 3) = brr
    
35.     Cells(Max, 1).Resize(m) = "合计："
    
36.     For i = Max To m + Max - 1
    
37.         s = Cells(i, 3) & "|" & Cells(i, 4)
    
38.         Cells(i, 5) = d1(s)
    
39.         s = Cells(i, 11) & "|" & Cells(i, 12)
    
40.         Cells(i, 13) = d2(s)
    
41.         Cells(i, 18) = Cells(i, 5) - Cells(i, 13)
    
42.     Next
    
43.     Set d = Nothing
    
44.     MsgBox "OK！"
    
45. End Sub
    

复制代码

左少右多的情况。

7993708

ykcbf1100 发表于 2024-7-21 18:35
改一下，以适应可能的
左少右多的情况。

感谢帮助,辛苦了.   

7993708

chxw68 发表于 2024-7-20 21:27
修改好了。

感谢老师.运行非常完美   

7993708

chxw68 发表于 2024-7-20 21:27
修改好了。

老师,,我向右移动2列, 左边数量后面加多了2列,,改了一上午改不出来  老师看看我上面代码哪里没改到.谢谢

chxw68

修改好了。