Vba 字典相加

今天有同事发现需要A列和B列相同的数，把C列相加，这边我们用字典操作最快：

source Worksheet : 

这边我们可以忽略D E F G列，那些只是公式

上CODE:

 

Sub Combine2()

Dim r As Integer

Dim sht_s As Worksheet ' source sht

Dim sht_r As Worksheet ' result sht

Set sht_s = ThisWorkbook.Worksheets("source")

Set sht_r = ThisWorkbook.Worksheets("result")

arr = sht_s.Range("a1").CurrentRegion

Set d = CreateObject("scripting.dictionary")

For i = 2 To UBound(arr)

If d.exists(arr(i, 1) & arr(i, 2)) Then

d(arr(i, 1) & arr(i, 2)) = Array(arr(i, 1), arr(i, 2), arr(i, 3) + d(arr(i, 1) & arr(i, 2))(2), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), "True")

Else

d(arr(i, 1) & arr(i, 2)) = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), "")

End If

Next

With sht_r

.Cells.Clear

.Range("A1") = "item"

.Range("B1") = "Amount"

.Range("H1") = "Plus or not"

 

r = 2

For Each dk In d.keys

.Range("A" & r).Resize(, 8) = d(dk)

r = r + 1

Next

End With

End Sub

 

虽然数据只有7列，我们加多一列，到时候可以加入标题.Range("H1") = "Plus or not"  以作Title Filter,就可以知道哪些是可以加一起的。

result Worksheet :