vba - 折叠/展开部分中的行

Question

我的数据在这样的分组方案中分为三个连续的类别:



因此，整个“OCM”组被分解为名为“N/A”、“Financials”、“Industrials”等的子组，每个子组又被分解为进一步的子组。

我在 Excel 中有相同的数据，但不幸的是它是自动格式化的，如下所示:



不是对这些部分进行分组，而是将所有内容都扩展了，并且只有一个空间来指示新子组的开始位置。

数据扩展到数千行，因此无法手动对其进行分组。是否有另一种自动分组数据的方法，其中空格表示子组？

编辑

Function indenture(r As Range) As Integer
indenture = r.IndentLevel
End Function

然后 nodeOrd = Sheet1.Range("A" & i).IndentLevel返回正确的缩进级别。

Answer 1

解决方案 1 - 使用组

Private Sub Workbook_Open()
    With Sheet1
        Dim i As Long, varLast As Long

        .Cells.ClearOutline
        varLast = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Columns("A:A").Insert Shift:=xlToRight 'helper column

        For i = 1 To varLast
            .Range("A" & i) = .Range("B" & i).IndentLevel
        Next

        Dim rngRows As Range, rngFirst As Range, rngLast As Range, rngCell As Range, rowOffset As Long

        Set rngFirst = Range("A1")
        Set rngLast = rngFirst.End(xlDown)
        Set rngRows = Range(rngFirst, rngLast)

        For Each rngCell In rngRows
            rowOffset = 1

            Do While rngCell.Offset(rowOffset) > rngCell And rngCell.Offset(rowOffset).Row <= rngLast.Row
                rowOffset = rowOffset + 1
            Loop

            If rowOffset > 1 Then
                Range(rngCell.Offset(1), rngCell.Offset(rowOffset - 1)).EntireRow.Group
            End If
        Next

        .Columns("A:A").EntireColumn.Delete
    End With
End Sub

解决方案 2 - 如果您不想修改工作簿数据 - 解决方法

第 1 步 - 创建 UserForm并添加 TreeView控制



第 2 步 - 在 UserForm 中添加以下代码代码

Private Sub UserForm_Initialize()
    With Me.TreeView1
        .Style = tvwTreelinesPlusMinusText
        .LineStyle = tvwRootLines
    End With

    Call func_GroupData
End Sub

Private Sub func_GroupData()
    varRows = CLng(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row)

    With Me.TreeView1.Nodes
        .Clear

        For i = 1 To varRows
            nodeTxt = Sheet1.Range("A" & i)
            nodeOrd = Sheet1.Range("A" & i).IndentLevel
            nodeTxt = Trim(nodeTxt)
            nodeAmt = Trim(CStr(Format(Sheet1.Range("B" & i), "###,###,###,##0.00")))

            Select Case nodeOrd
                Case 0 'Level 0 - Root node
                    nodeTxt = nodeTxt & Space(80 - Len(nodeTxt & nodeAmt)) & nodeAmt
                    .Add Key:="Node" & i, Text:=Trim(nodeTxt)
                    nodePar1 = "Node" & i
                Case 1 'Level 1 node
                    nodeTxt = nodeTxt & Space(80 - Len(nodeTxt & nodeAmt)) & nodeAmt
                    .Add Relative:=nodePar1, Relationship:=tvwChild, Key:="Node" & i, Text:=Trim(nodeTxt)
                    nodePar2 = "Node" & i
                Case 2 'Level 2 node
                    nodeTxt = nodeTxt & Space(80 - Len(nodeTxt & nodeAmt)) & nodeAmt
                    .Add Relative:=nodePar2, Relationship:=tvwChild, Key:="Node" & i, Text:=Trim(nodeTxt)
                    nodePar3 = "Node" & i
            End Select

        Next
    End With
End Sub

第 3 步 - 在 ThisWorkbook 中添加以下代码显示 TreeView

Private Sub Workbook_Open()
    UserForm1.Show vbModeless
End Sub

结果