麻辣家族討論版版 - Powered by Discuz! Board

Sub ex()
Dim ar()
Set D = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheets.Add
For Each sh In Sheets(Array("01", "02", "03", "04"))
ReDim Preserve ar(s)
ar(s) = sh.[A1].CurrentRegion.Address(, , xlR1C1, 1)
s = s + 1
Next
.Range("A1").Consolidate Sources:=ar, Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
For Each a In .Range(.[B1], .[IV1].End(xlToLeft))
If IsEmpty(D(Split(a, "-")(0))) Then
Set D(Split(a, "-")(0)) = a.Resize(.UsedRange.Rows.Count, 1)
Else
Set D(Split(a, "-")(0)) = Union(a.Resize(.UsedRange.Rows.Count, 1), D(Split(a, "-")(0)))
End If
Next
Set Rng = .Range(.[A1], .[A65536].End(xlUp))
For Each ky In D.keys
With Sheets("SUM-" & ky)
Rng.Copy .[A1]
D(ky).Copy .[B1]
End With
Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True
End Sub

複製代碼