|
- Sub 按客户名称列拆分成多表()
- Application.DisplayAlerts = False
- Dim sh As Worksheet
- Dim d As Object
- Dim arr As Variant
- Dim i, s As Integer
- Set d = CreateObject("scripting.dictionary")
- For Each sh In Worksheets
- If sh.Name <> "总表" Then
- sh.Delete
- End If
- Next sh
- arr = Sheets("总表").[a1].CurrentRegion
- For i = 2 To UBound(arr)
- If Not d.exists(Split(arr(i, 3), " ")(1)) Then
- Set d(Split(arr(i, 3), " ")(1)) = Sheets("总表").Range("a" & i).Resize(1, UBound(arr, 2))
- Else
- Set d(Split(arr(i, 3), " ")(1)) = Union(d(Split(arr(i, 3), " ")(1)), Sheets("总表").Range("a" & i).Resize(1, UBound(arr, 2)))
- End If
- Next i
- x = d.keys
- For i = 0 To UBound(x)
- Set sh = Worksheets.Add(after:=Sheets(Sheets.Count))
- sh.Name = x(i)
- Sheets("总表").[a1:g1].Copy sh.[a1]
- d.items()(i).Copy sh.[a2]
- Next i
- Application.DisplayAlerts = True
- End Sub
复制代码 |
|