求助：也来个去重的，根据A列和C列的数据去重，并把D列求和

ykcbf1100

幽默的熊 发表于 2024-8-2 09:59
这次是我没表述清楚, 情况稍微复杂一点.
1. 行列数并不完全统一, 有长有短, 最后需要都放在一起(g列开始 ...

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.2
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     With Sheets("求助")
   
6.         r = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 6)
   
8.         ReDim brr(1 To UBound(arr), 1 To 6)
   
9.         For i = 1 To UBound(arr)
   
10.             If InStr(arr(i, 2), "tt") = 0 Then
    
11.                 m = m + 1
    
12.                 For j = 1 To UBound(arr, 2)
    
13.                     brr(m, j) = arr(i, j)
    
14.                 Next
    
15.             Else
    
16.                 s = arr(i, 1) & "|" & arr(i, 3)
    
17.                 If Not d.Exists(s) Then
    
18.                     m = m + 1
    
19.                     d(s) = m
    
20.                     brr(m, 1) = arr(i, 1)
    
21.                     brr(m, 2) = arr(i, 2)
    
22.                     brr(m, 3) = arr(i, 3)
    
23.                     brr(m, 4) = arr(i, 4)
    
24.                 Else
    
25.                     r = d(s)
    
26.                     brr(r, 4) = brr(r, 4) + arr(i, 4)
    
27.                 End If
    
28.             End If
    
29.         Next
    
30.         .[g1].Resize(10000, 100) = ""
    
31.         .Columns(8).NumberFormatLocal = "@"
    
32.         .[g1].Resize(m, 6) = brr
    
33.     End With
    
34.     Set d = Nothing
    
35.     Application.ScreenUpdating = True
    
36.     MsgBox "OK！"
    
37. End Sub
    

复制代码

gwjkkkkk

。。。。。。。。。。。。