多条重复数据累加

望涯2529

哪位大神帮忙下， EXCEL表1第一列有很多重复数据，如何在表2中重复的数据只保留一个，并且需把重复数据对应的数量进行累加，保存在对应的D列里，显示结果如图。数据有几百条，怎么用VBA实现，谢谢了哦。

全党

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

zxsea_7426

1. Sub 数据累计()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. ar = Sheet1.[a1].CurrentRegion
   
4. For i = 2 To UBound(ar)
   
5.     d(ar(i, 1)) = d(ar(i, 1)) + ar(i, 3)
   
6. Next i
   
7. Sheet2.UsedRange.Resize(, 4).Offset(1).ClearContents '[a2].Resize(d.Count, 1)
   
8. Sheet2.[a2].Resize(d.Count, 1) = Application.Transpose(d.keys)
   
9. Sheet2.[d2].Resize(d.Count, 1) = Application.Transpose(d.items)
   
10. End Sub
    

复制代码

奇诺.

1. Sub leijia()
   
2.     Dim arr, b
   
3.     Dim a
   
4.     Dim d, k, t
   
5.     a = Sheet1.[a999999].End(xlUp).Row
   
6.     b = Sheet2.[a999999].End(xlUp).Row
   
7.     If b > 1 Then
   
8.         Sheet2.Range("A2:d" & b).Clear
   
9.     End If
   
10.     arr = Sheet1.Range("a1:c" & a)
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     For a = 2 To UBound(arr)
    
13.         d(arr(a, 1)) = d(arr(a, 1)) + arr(a, 3)
    
14.     Next
    
15.     k = d.keys
    
16.     t = d.items
    
17.     Sheet2.[A2].Resize(d.Count, 1) = Application.Transpose(k)
    
18.     Sheet2.[d2].Resize(d.Count, 1) = Application.Transpose(t)
    
19.     Set d = Nothing
    
20. End Sub
    

复制代码

奇诺.

ykcbf1100

字典排重汇总。

lizhipei78

ykcbf1100 发表于 2023-3-31 14:33
字典排重汇总。

我有一个疑问，本身这个就可以直接用keys及items直接输出结果了，为什么要重复一次for each循环写进数组，难道直接输出结果不比循环快吗？

全党

lizhipei78 发表于 2023-4-1 10:14
我有一个疑问，本身这个就可以直接用keys及items直接输出结果了，为什么要重复一次for each循环写进数组 ...

主要是为了普适性，如果仅仅是需要项目名称和累计值当然你说的可以。如果每个项目还需要其他数据列出，老师的代码就显出优势了。

ykcbf1100

lizhipei78 发表于 2023-4-1 10:14
我有一个疑问，本身这个就可以直接用keys及items直接输出结果了，为什么要重复一次for each循环写进数组 ...

个人习惯问题。