Question

我正在尝试在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

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

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

Answer 1

你运气不好。

分组有8 level limit

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

Answer 2

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

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

check_col是一个必须填充到最后一行的列（即没有空行，或者＃34;而＃34;循环将停止
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

Excel中的分组深度级别是否存在约束？

2 个答案: