Sub classification()
Dim LastRow, max_level As Integer
Dim i, j, m, a, b As Integer
Dim st1, st2, s1, s2 As Integer
On Error Resume Next
Application.ScreenUpdating = False '運行時關閉屏幕更新。
LastRow = ActiveSheet.UsedRange.Rows.Count
max_level = 6
s1 = LastRow
st1 = LastRow
For a = max_level To 1 Step -1
If a > 2 Then
st1 = LastRow
s1 = LastRow
For b = LastRow To 1 Step -1
If Range("A" & b) < a - 1 Then
s1 = b - 1
ElseIf Range("A" & b) = a - 1 Then
s2 = b + 1
If s1 - s2 > 0 Then
Rows(s1 & ":" & s2).Select
Selection.Rows.Group
End If
s1 = b - 1
End If
Next b
End If
Next a
ActiveSheet.Outline.ShowLevels RowLevels:=1 'Minimize all the groups 最小化所有組
ActiveSheet.Outline.SummaryRow = xlAbove '將+放在每個組的第一行旁邊,而不是底部的應用程序?
Application.ScreenUpdating = True 'Turns on screen updating when done.
End Sub
作用:根據序號 對大量數據進行分級,分類。