Sub test() Dim r%, i% Dim arr, brr Dim d As Object Set d = CreateObject("scripting.dictionary") Set d1 = CreateObject("scripting.dictionary") With Worksheets("总表") r = .Cells(.Rows.Count, 1).End(xlUp).Row arr = .Range("a1:a" & r) For i = 2 To UBound(arr) If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = .Range("a1:f1") End If Set d(arr(i, 1)) = Union(d(arr(i, 1)), .Cells(i, 1).Resize(1, 6)) Next End With For Each ws In Worksheets d1(ws.Name) = "" Next For Each aa In d.keys If Not d1.exists(aa) Then Set ws = Worksheets.Add(Worksheets(Worksheets.Count)) ws.Name = aa End If With Worksheets(aa) .Cells.Clear d(aa).Copy .Range("a1") r = .Cells(.Rows.Count, 1).End(xlUp).Row .Range("c" & r + 1 & ",f" & r + 1).FormulaR1C1 = "=SUM(R2C:R" & r & "C)" End With Next End Sub
|