数据汇总减汇总等于结存

7993708

求助大佬们:


VBA实现左边数据去重后统计数据.再复制去重后的名称在右边汇总数据


左边数据汇总减右边汇总数,,  灰色部分为VBA实现的内容.放在数据尾部隔一行空白行... 没有送货的产品数量为0      ,WPS  谢谢

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.20
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     For i = 10 To 15
   
4.         s = Cells(i, 3) & "|" & Cells(i, 4)
   
5.         d(s) = d(s) + Cells(i, 5)
   
6.     Next
   
7.     For i = 18 To 21
   
8.         s = Cells(i, 3) & "|" & Cells(i, 4)
   
9.         If d.exists(s) Then
   
10.             Cells(i, 5) = d(s)
    
11.         End If
    
12.     Next
    
13.     d.RemoveAll
    
14.     For i = 10 To 15
    
15.         s = Cells(i, 11) & "|" & Cells(i, 12)
    
16.         d(s) = d(s) + Cells(i, 13)
    
17.     Next
    
18.     For i = 18 To 21
    
19.         s = Cells(i, 11) & "|" & Cells(i, 12)
    
20.         If d.exists(s) Then
    
21.             Cells(i, 13) = d(s)
    
22.         End If
    
23.         Cells(i, "r") = Cells(i, 5) - Cells(i, 13)
    
24.     Next
    
25.     Set d = Nothing
    
26.     MsgBox "OK！"
    
27. End Sub

复制代码

7993708

ykcbf1100 发表于 2024-7-20 16:10
附件供参考。。。

老师没有数据
这是样式数据,,真实数据很多,每个客户数据行数也不一样,,这样还要每次都修改代码行数位置
...VBA实现去重...手工去重多很多功夫,还容易出错..谢谢

ykcbf1100

下面的数据你不能删除，如果删除，则现在的代码无法汇总数据。
关键是你这表，数据行数固定的，不然，这个表得整体插入行。

7993708

ykcbf1100 发表于 2024-7-20 16:31
下面的数据你不能删除，如果删除，则现在的代码无法汇总数据。
关键是你这表，数据行数固定的，不然，这个 ...

数据行数是有多有少不固定的,,,,所以不能手工去重,应该检测到未尾数据VBA去重并统汇总

ykcbf1100

7993708 发表于 2024-7-20 16:53
数据行数是有多有少不固定的,,,,所以不能手工去重,应该检测到未尾数据VBA去重并统汇总

那你这样的话，这个表有可能要插入行的。变复杂了。

7993708

ykcbf1100 发表于 2024-7-20 18:09
那你这样的话，这个表有可能要插入行的。变复杂了。

是的, 要定位最后一行数据,要复制去重

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Dim rng As Range
   
6.     Application.ScreenUpdating = False
   
7.     Application.DisplayAlerts = False
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     With Worksheets("对账单")
   
10.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.         Set rng = .Rows(r + 1)
    
12.         For i = 10 To r - 3
    
13.             If Not IsDate(.Cells(i, 1).Value) Then
    
14.                 Set rng = Union(rng, .Rows(i))
    
15.             End If
    
16.         Next
    
17.         rng.Delete
    
18.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
19.         arr = .Range("a10:s" & r - 3)
    
20.         For i = 1 To UBound(arr)
    
21.             For j = 1 To 9 Step 8
    
22.                 xm = arr(i, j + 2) & "+" & arr(i, j + 3)
    
23.                 If Not d.exists(xm) Then
    
24.                     ReDim brr(1 To UBound(arr, 2))
    
25.                     brr(1) = "合计"
    
26.                 Else
    
27.                     brr = d(xm)
    
28.                 End If
    
29.                 brr(j + 2) = arr(i, j + 2)
    
30.                 brr(j + 3) = arr(i, j + 3)
    
31.                 brr(j + 4) = brr(j + 4) + arr(i, j + 4)
    
32.                 d(xm) = brr
    
33.             Next
    
34.         Next
    
35.         ReDim crr(1 To d.Count, 1 To UBound(brr))
    
36.         m = 0
    
37.         For Each aa In d.keys
    
38.             brr = d(aa)
    
39.             brr(18) = brr(5) - brr(13)
    
40.             m = m + 1
    
41.             For j = 1 To UBound(brr)
    
42.                 crr(m, j) = brr(j)
    
43.             Next
    
44.         Next
    
45.         If m > 0 Then
    
46.             .Rows(r - 2).Resize(1 + UBound(crr)).Insert
    
47.             .Cells(r - 1, 1).Resize(UBound(crr), UBound(crr, 2)) = crr
    
48.         End If
    
49. 
    
50.     End With
    
51. End Sub
    

复制代码

chxw68

练手。。。