|
- Sub gj23w98()
- Set rng = Range("a1:e1")
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- arr = [a1].CurrentRegion
- Set d = CreateObject("scripting.dictionary")
- For i = 2 To UBound(arr): c = UBound(arr, 2)
- If Not d.exists(arr(i, 1)) Then
- Set d(arr(i, 1)) = Cells(i, 1).Resize(1, c)
- Else
- Set d(arr(i, 1)) = Union(d(arr(i, 1)), Cells(i, 1).Resize(1, c))
- End If
- Next
- k = d.keys
- t = d.items
- For i = 0 To d.Count - 1
- Set wb = Workbooks.Add
- With wb.Sheets(1)
- rng.Copy .[a1]: t(i).Copy .[a2]
- For j = 1 To UBound(arr, 2)
- .Columns(j).ColumnWidth = ThisWorkbook.ActiveSheet.Columns(j).ColumnWidth
- Next
- End With
- wb.SaveAs Filename:=ThisWorkbook.Path & "" & k(i)
- wb.Close
- Next
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码 |
|