|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
'假设A列有序
Option Explicit
Sub test()
Dim arr, i, dic, n
Set dic = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion.Offset(1).Value
For i = 1 To UBound(arr, 1) - 1
If Not dic.exists(arr(i, 2)) Then n = n + 1: dic(arr(i, 2)) = n + 1
Next
ReDim brr(1 To UBound(arr, 1), 1 To dic.Count + 1)
n = 1
For i = 1 To UBound(arr, 1) - 1
brr(n, (dic(arr(i, 2)))) = brr(n, (dic(arr(i, 2)))) + arr(i, 3)
If arr(i, 1) <> arr(i + 1, 1) Then brr(n, 1) = arr(i, 1): n = n + 1
Next
With [e2]
.Offset(-1, 1).Resize(, dic.Count) = dic.keys
.Resize(Rows.Count - 1, UBound(brr, 2)).ClearContents
If n > 0 Then .Resize(n - 1, UBound(brr, 2)) = brr
End With
End Sub |
评分
-
1
查看全部评分
-
|