|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub a()
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Dim arr, brr, i&, s$
arr = [a1].CurrentRegion '数据源
For i = 1 To UBound(arr) '含标题
s = arr(i, 1) & "|" & arr(i, 3) '条件
If Not d.Exists(s) Then
ReDim brr(1 To 3)
brr(1) = arr(i, 1)
brr(2) = "=" & arr(i, 2)
brr(3) = arr(i, 3)
Else
brr = d(s)
brr(2) = brr(2) & "+" & arr(i, 2)
End If
d(s) = brr
Next
''生成位置
With [e1]
.CurrentRegion.Clear '清除内容
.Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.items))
.Offset(0, 1) = arr(1, 2)
End With
Set d = Nothing
End Sub |
评分
-
1
查看全部评分
-
|