excel 自动group脚本

来源:互联网 发布:算法的定义和特征 编辑:程序博客网 时间:2024/06/06 16:35
Sub autogroup()

Dim k
    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight
    End With
    
max_rows = ActiveSheet.UsedRange.Rows.Count
max_cols = ActiveSheet.UsedRange.Columns.Count


Range(Cells(1, 1), Cells(max_rows, 1)).ClearOutline


Range("A" & max_rows + 1).Value = 1


For ii = 2 To max_cols - 2
    i = max_cols - ii
    
    For j = 1 To max_rows + 1
         If Application.CountIf(Range(Cells(j, 1), Cells(j, i)), "<>") = 0 Then
            If (flag = 1) Then
               k = k
            Else
               k = j
            End If
            flag = 1
         ElseIf (flag = 1) Then
            Range(Cells(k, 1), Cells(j - 1, 1)).Rows.Group
            k = 1
            flag = 0
         End If
    Next
Next


Range("A" & max_rows + 1).Value = ""




End Sub
原创粉丝点击