Excel中VBA操作相关数组和字典

VBA操作Excel中数组分类汇总：

Sub VBA数组分类汇总()
Dim arr1()
arr = [a2:c13]
For i = 1 To UBound(arr)
    ReDim Preserve arr1(1 To 2, 1 To n + 1)
    For j = 1 To UBound(arr1, 2)
        If arr1(1, j) = arr(i, 1) Then
            arr1(2, j) = arr1(2, j) + arr(i, 3)
            GoTo 100
        End If
    Next
        n = n + 1
        arr1(1, n) = arr(i, 1)
        arr1(2, n) = arr(i, 3)
100:
Next
[e2].Resize(n, 2) = Application.Transpose(arr1)
End Sub

VBA操作Exce中Fileter函数与数组：

Sub 筛选()
[d2:f999].Clear
i = Cells(Rows.Count, 1).End(xlUp).Row
Range("c2:c" & i).FormulaArray = "=a2:a" & i & " & ""-"" & b2:b" & i
arr = Range("c2:c1" & i)
Range("c2:c1" & i).Clear
a = Filter(Application.Transpose(arr), [g1], True)
For Each b In a
    n = n + 1
    c = Split(b, "-")
    Cells(n + 1, "d") = c(0)
    Cells(n + 1, "e") = c(1)
Next
End Sub

VBA操作Exce中字典实例(字典与数组经典结合)：

Sub test()
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1:b" & Sheet1.Cells(Rows.Count, "a").End(xlUp).Row)
For Each Rng In arr
    arr1 = VBA.Split(Rng, "|")
    For Each rngs In arr1
        d(rngs) = ""
    Next
    i = VBA.Join(d.keys, "|")
    n = n + 1
    Sheet2.Cells(n, "a") = i
    d.RemoveAll
Next
End Sub

VBA操作Exce中字典应用（多列合并计算）：

Sub 多列合并计算()
Dim arr1()
Set d = CreateObject("scripting.dictionary")
arr = Range("a2:d" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
     If Not d.exists(arr(i, 1)) Then
        n = n + 1
        d(arr(i, 1)) = n
        ReDim Preserve arr1(1 To 4, 1 To n)
        arr1(1, n) = arr(i, 1)
        arr1(2, n) = arr(i, 2)
        arr1(3, n) = arr(i, 3)
        arr1(4, n) = arr(i, 4)
    Else
        m = d(arr(i, 1))
        arr1(2, m) = arr1(2, m) + arr(i, 2)
        arr1(3, m) = arr1(3, m) + arr(i, 3)
        arr1(4, m) = arr1(4, m) + arr(i, 4)
     End If
Next
[f2].Resize(n, 4) = Application.Transpose(arr1)
End Sub

VBA操作Exce中字典实例(分类计算)：

Sub 分类求和()
Dim arr1
Set d = CreateObject("scripting.dictionary")
arr = Range("b2:c" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
Next
[e8].Resize(d.Count) = Application.Transpose(d.keys)
[f8].Resize(d.Count) = Application.Transpose(d.items)
End Sub

Sub 分类计数()
Dim arr1
Set d = CreateObject("scripting.dictionary")
arr = Range("b2:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For Each Rng In arr
    i = d(Rng)
    d(Rng) = d(Rng) + 1
    i = d(Rng)
Next
[e1].Resize(d.Count) = Application.Transpose(d.keys)
[f1].Resize(d.Count) = Application.Transpose(d.items)
End Sub