Vba Excel 自動分級

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

作用:根據序號  對大量數據進行分級,分類。

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章