|
楼主 |
发表于 2022-7-17 13:57
|
显示全部楼层
Sub text5()
Dim arr, rngHead As Range, rngTotal As Range, d As Object, _
k, t, r&, i&, lr&, lc%, sh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
arr = Range("a1").CurrentRegion
lr = UBound(arr)
lc = UBound(arr, 2)
Set rngHead = Rows(1)
Set rngTotal = Rows(lr)
Set d = CreateObject("scripting.dictionary")
For i = 2 To lr
If Not d.Exists(arr(i, 1)) Then
Set d(arr(i, 1)) = Cells(i, 1).Resize(, lc)
Else
Set d(arr(i, 1)) = Union(d(arr(i, 1)), Cells(i, 1).Resize(, lc))
End If
Next
k = d.Keys
t = d.Items
With Sheets
For i = 0 To d.Count - 1
With .Add(after:=.Item(.Count))
.Name = k(i)
rngHead.Copy .[a1]
.Cells(1, 1).Resize(, lc).Columns.AutoFit
t(i).Copy .[a2]
End With
Next
End With
Sheets(1).Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
我试了人家写的这个,蓝色部分用copy,我去运行它能正常运行。
|
|