|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub test()
- Dim d, arr, i&, j&, m&, n&, s, g, w
- Set d = CreateObject("Scripting.Dictionary")
- arr = [a1].CurrentRegion.Value
- ReDim brr(1 To UBound(arr), 1 To 10)
- m = 1: n = 1: brr(m, n) = "姓名"
- For i = 2 To UBound(arr)
- s = arr(i, 1): g = arr(i, 2): w = s & g
- If Not d.exists(s) Then
- m = m + 1
- d(s) = m
- brr(m, 1) = s
- End If
- If Not d.exists(g) Then
- n = n + 1
- d(g) = n
- brr(1, n) = g
- End If
- d(w) = d(w) + arr(i, 3)
- Next
- For i = 2 To m
- For j = 2 To n
- w = brr(i, 1) & brr(1, j)
- brr(i, j) = d(w)
- Next
- Next
- [f1].CurrentRegion.Clear
- [f1].Resize(m, n) = brr
- End Sub
复制代码 |
|