|
- Sub Macro1()
- Dim arr, brr, d, i&, j%
- Set d = CreateObject("scripting.dictionary")
- w = Array("A", "B", "C", "D", "E", "F")
- arr = Range("a1:b" & Range("a65536").End(xlUp).Row)
- ReDim brr(1 To UBound(arr) - 1, 1 To UBound(w) + 1)
- For i = 2 To UBound(arr)
- x = Split(arr(i, 2), "、")
- s = arr(i, 1) / (UBound(x) + 1)
- For j = 0 To UBound(x)
- d(x(j)) = d(x(j)) + s
- Next
- Next
- For i = 2 To UBound(arr)
- x = Split(arr(i, 2), "、")
- For j = 0 To UBound(x)
- n = Application.Match(x(j), w, 0)
- brr(i - 1, n) = d(x(j))
- Next
- Next
- Range("d2").Resize(UBound(brr), UBound(brr, 2)) = brr
- End Sub
复制代码 |
|