|
Sub chaifen()
Set d = CreateObject("scripting.dictionary")
ar = ActiveSheet.[a1].CurrentRegion
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" Then
d(Trim(ar(i, 1))) = ""
End If
Next i
Application.SheetsInNewWorkbook = 1
For j = 3 To UBound(ar, 2)
If Trim(ar(1, j)) <> "" Then
Set wb = Workbooks.Add
For Each k In d.keys
n = 0
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) = k Then
n = n + 1
For s = 1 To UBound(ar, 2)
br(n, s) = ar(i, s)
Next s
End If
Next i
Set sh = Sheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
sh.Name = Format(k, "00") & "试场"
sh.[a1].Resize(1, 2) = Array("试场", "座号")
sh.[a2].Resize(n, UBound(br, 2)) = br
Next k
Application.DisplayAlerts = False
wb.Worksheets(1).Delete
Application.DisplayAlerts = True
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ar(1, j)
wb.Close
End If
Next j
End Sub
|
评分
-
1
查看全部评分
-
|