|
自己查看
- Sub DicTest()
- Dim dica As Object, dicb As Object, Arr1, arr2()
- Set dica = CreateObject("scripting.dictionary")
- Set dicb = CreateObject("scripting.dictionary")
- Arr1 = Range("A1").CurrentRegion
- For x = 2 To UBound(Arr1, 1)
- If Not dicb.exists(Arr1(x, 1)) Then
- k = k + 1
- dicb(Arr1(x, 1)) = k + 1
- End If
- Next x
-
- ReDim arr2(1 To 1000, 1 To dicb.Count + 1)
- For y = 2 To UBound(Arr1, 1)
- If dica.exists(Arr1(y, 2)) Then
- a = dica(Arr1(y, 2))
- b = dicb(Arr1(y, 1))
- arr2(a, b) = arr2(a, b) + Arr1(y, 3)
- Else
- m = m + 1
- dica(Arr1(y, 2)) = m
- n = dicb(Arr1(y, 1))
- arr2(m, 1) = Arr1(y, 2)
- arr2(m, n) = Arr1(y, 3)
- End If
- Next
-
- Range("N1:R" & Rows.Count) = ""
- [N1] = "单位"
- [O1].Resize(1, dicb.Count) = dicb.keys
- [N2].Resize(dica.Count, dicb.Count + 1) = arr2
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|