|
Sub main()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim d As Object, arr, i&, j&, sht, BT
BT = Sheets("总成绩").[A3:M3]
Set d = CreateObject("scripting.dictionary")
arr = Sheets("总成绩").[a3].CurrentRegion.Offset(3)
For Each sht In Sheets
If sht.Name <> "总成绩" Then sht.Delete
Next
For i = 1 To UBound(arr) - 3
d(arr(i, 1)) = ""
Next
For i = 0 To d.Count - 1
Sheets.Add.Name = d.keys()(i)
Set sht = Sheets(d.keys()(i))
Call tq(arr, sht, BT)
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub tq(arr, sht, BT)
Dim i&, j&, m&
For i = 1 To UBound(arr)
If arr(i, 1) = sht.Name Then
m = m + 1
For j = 1 To UBound(arr, 2)
arr(m, j) = arr(i, j)
Next
End If
Next
sht.[A1].Resize(1, UBound(BT, 2)) = BT
sht.[a2].Resize(m, UBound(arr, 2)) = arr
End Sub
|
评分
-
1
查看全部评分
-
|