vba Excel 中分组的深度级别是否有限制？

Is there a constraint on the depth level of grouping in Excel?

提问by Jagger

I am trying to write a macro in Excel which will allow me to automatically do groupings based on the number located in the first column. Here is the code.

我正在尝试在 Excel 中编写一个宏，它允许我根据第一列中的数字自动进行分组。这是代码。

Sub Makro1()
Dim maxRow As Integer
Dim row As Integer
Dim groupRow As Integer
Dim depth As Integer
Dim currentDepth As Integer

maxRow = Range("A65536").End(xlUp).row

For row = 1 To maxRow
    depth = Cells(row, 1).Value
    groupRow = row + 1
    currentDepth = Cells(groupRow, 1).Value
    If depth >= currentDepth Then
       GoTo EndForLoop
    End If
    Do While currentDepth > depth And groupRow <= maxRow
        groupRow = groupRow + 1
        currentDepth = Cells(groupRow, 1).Value
    Loop
    Rows(row + 1 & ":" & groupRow - 1).Select
    Selection.Rows.Group
EndForLoop:
    Next row
End Sub

The first column in the Excel file looks like this:

Excel 文件中的第一列如下所示：

1
2
2
3
3
4
4
4
4
5
5
5
6
6
6
6
5
6
6
6
7
8
8
9
10
9
10
10
8
7
7
8
6
5
4
3
2
1
2

When the macro reaches the depth 8 speaking of the groupings, I get error number 1004. It looks like the Excel does not allow me to create a depth greater than 8. Is there a workaround for this? I am using MS Excel 2003.

当宏达到分组的深度 8 时，我收到错误号 1004。看起来 Excel 不允许我创建大于 8 的深度。是否有解决方法？我正在使用 MS Excel 2003。

回答by brettdj

You are out of luck.

你倒霉了。

There is an 8 level limitfor grouping which

分组有8 级限制，其中

• also exists in xl07
• on my testing exists in xl2010 (gives "Group method of range class failed")

• 也存在于 xl07
• 在我的测试中存在于 xl2010（给出“范围类的组方法失败”）

回答by Amir Sabbagh

I wrote this code to hide the sublevel rows, like grouping does.

我写了这段代码来隐藏子级别的行，就像分组一样。

it needs the first row empty, where the general level buttons will be placed. it will create a button (placed in the first column) for each node with sublevels. Clicking on the buttons will hide/unhide the corresponding sublevels.

它需要第一行为空，一般级别按钮将被放置在其中。它将为每个具有子级别的节点创建一个按钮（放置在第一列中）。单击按钮将隐藏/取消隐藏相应的子级别。

• the check_col is a colum that must be filled up to the last rows (i.e. no blank rows, or the "while" loop will stop
• the lvl_col is the column that contains the level index
• the start_row is the first row that contains useful data

• check_col 是一个必须填充到最后一行的列（即没有空行，否则“while”循环将停止
• lvl_col 是包含级别索引的列
• start_row 是包含有用数据的第一行

hope this helps

希望这可以帮助

Sub group_tree()
check_col = "A"
lvl_col = "D"
start_row = 3


Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete

Dim t As Range

'------------Place the buttons on top--------------
i = start_row
e_lvl = 0
b_spac = 0
b_width = 20
b_toggle = 0
While Range(check_col & i) <> ""
    lvl = Range(lvl_col & i)
    If lvl > e_lvl Then e_lvl = lvl
i = i + 1
Wend

Set t = ActiveSheet.Range("A" & 1)
For c = Range(lvl_col & start_row) To e_lvl
    Set btn = ActiveSheet.Buttons.Add(t.Left + b_spac, t.Top, b_width, 10)
    With btn
    .OnAction = "btnS_t"
    .Caption = c
    .Name = start_row & "_" & c & "_" & lvl_col & "_" & b_toggle
    End With
    b_spac = b_spac + 20
Next

'--------------Place the buttons at level---------

i = start_row
While Range(check_col & i) <> ""
    lvl = Range(lvl_col & i)
    If Range(lvl_col & i + 1) > lvl Then
    Set t = ActiveSheet.Range("A" & i)
    '    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, b_width, 10)
    With btn
      .OnAction = "btnS"
      .Caption = lvl
      .Name = i & "_" & lvl & "_" & lvl_col
    End With
    End If
    i = i + 1
Wend
  Application.ScreenUpdating = True
End Sub

Sub btnS()
    Dim but_r As Integer
    Set b = ActiveSheet.Buttons(Application.Caller)
    id_string = b.Name

    Dim id() As String
    id = Split(id_string, "_")
    start_row = CInt(id(0))
    start_lvl = CInt(id(1))
    lvl_col = id(2)

'    MsgBox (lvl_col)
    Call hide_rows(start_lvl, start_row, lvl_col)
End Sub

Sub hide_rows(start_lvl, start_row, lvl_col)
    a = start_row + 1
    While Range(lvl_col & a) > start_lvl
    a = a + 1
    Wend

    If Range(lvl_col & start_row + 1, lvl_col & a - 1).EntireRow.Hidden = False Then
    Range(lvl_col & start_row + 1, lvl_col & a - 1).EntireRow.Hidden = True
    Else
    Range(lvl_col & start_row + 1, lvl_col & a - 1).EntireRow.Hidden = False
    End If


End Sub
Sub btnS_t()
    Dim but_r As Integer
    Set b = ActiveSheet.Buttons(Application.Caller)
    id_string = b.Name

    Dim id() As String
    id = Split(id_string, "_")
    start_row = CInt(id(0))
    start_lvl = CInt(id(1))
    lvl_col = id(2)
    b_toggle = CInt(id(3))

    If b_toggle = 0 Then
    b_toggle = 1
    Else
    b_toggle = 0
    End If

    b.Name = start_row & "_" & start_lvl & "_" & lvl_col & "_" & b_toggle

    Call hide_rows_tot(start_lvl, start_row, lvl_col, b_toggle)
End Sub
Sub hide_rows_tot(start_lvl, start_row, lvl_col, b_toggle)

    a = start_row

    While Range(lvl_col & a) <> ""
    b = a
    While Range(lvl_col & b) > start_lvl
    b = b + 1
    Wend

    If b > a Then
    If b_toggle = 1 Then
        Range(lvl_col & a, lvl_col & b - 1).EntireRow.Hidden = True
    Else
        Range(lvl_col & a, lvl_col & b - 1).EntireRow.Hidden = False
    End If

    a = b - 1
    End If
    a = a + 1
    Wend



End Sub