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

我想在Excel中写一个macros，这将允许我自动根据位于第一列的编号进行分组。 这是代码。

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 

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 

当macros达到深度8说到分组，我得到错误号1004.它看起来像Excel不允许我创build一个深度大于8.有没有解决这个问题？ 我正在使用MS Excel 2003。

Answer 1

你不走运。

有一个8级限制分组

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

Answer 2

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

它需要第一行为空，其中一般的水平button将被放置。 它会为每个节点创build一个button（放置在第一列）。 点击button将隐藏/取消隐藏相应的子平面。

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

希望这可以帮助

 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