|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 按钮1_Click()
Dim d As Object
Dim ar As Variant
Dim br()
Set d = CreateObject("scripting.dictionary")
ar = Sheet1.[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To UBound(ar))
y = 2: k = 1
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
zf = Trim(ar(i, 1)) & "|" & Trim(ar(i, 2))
t = d(zf)
If t = "" Then
k = k + 1
d(zf) = k
t = k
br(k, 1) = ar(i, 1)
br(k, 2) = ar(i, 2)
End If
If Not d.exists(Trim(ar(i, 3))) Then
y = y + 1
br(1, y) = ar(i, 3)
d(Trim(br(1, y))) = y
br(t, y) = br(t, y) + ar(i, 4)
ElseIf d.exists(Trim(ar(i, 3))) Then
m = d(Trim(ar(i, 3)))
br(t, m) = br(t, m) + ar(i, 4)
End If
End If
Next i
With Sheets("效果")
.[a1].CurrentRegion = Empty
.[a1].Resize(k, y) = br
End With
MsgBox "ok!"
End Sub
|
|