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

作用:根据序号  对大量数据进行分级,分类。

Vba  Excel 自动分级

上一篇:VBA比较两个Excel数据的异同


下一篇:VBA典型的技巧和示例