46、[VBA入门到放弃笔记]字典对合并单元格的求和

合并单元格是Excel中比较蛋疼的东东，但至今仍有不少使用合并单元格的案例。如下图，需要对ABCDE进行求和。

数据

---

Sub comm()
    Dim arr, R&, i&, d As Object
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For i = 1 To UBound(arr)
        If arr(i, 2) <> "" Then  '//如果B列单元格不为空
            R = i       '//标记此时的行号
            d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2) '//求和
        Else   '//如果B列单元格为空
 '//求和,注意arr(R, 2) R取标记的行号，也就是合并单元格区域中有数据的单元格
           d(arr(i, 1)) = d(arr(i, 1)) + arr(R, 2) 
        End If
    Next
    [d1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items)) '//输出数据
End Sub

结果：

结果

---

此题目同样可以改版，变成求和的key是合并单元格

数据

---

同样采取标记行的做法，代码如下，不解释了。

Sub comm()
    Dim arr, R&, i&, d As Object
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then
            R = i
            d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
        Else
            d(arr(R, 1)) = d(arr(R, 1)) + arr(i, 2)
        End If
    Next
    [d1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

结果

结果

要充分利用循环遍历干点神马事情，一切都可以在当中发生。