折叠/展开部分中的行

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 中添加以下代码以显示树视图

Private Sub Workbook_Open()
    UserForm1.Show vbModeless
End Sub

结果

Answer 2

一种可能性是为每个单元格添加一个按钮，并在collapse 上隐藏其子行，并在expand 上显示其子行。

每个Excel.Button 执行一个公共方法TreeNodeClick，其中Click 方法在TreeNode 的相应实例上调用。根据按钮的实际标题隐藏或显示子行。

一开始在执行Main方法时需要选择源数据范围。问题是每次打开工作表时都需要填充树节点的集合。所以Main方法需要在工作表打开时执行，否则将不起作用。

---

标准模块代码：

Option Explicit

Public treeNodes As VBA.Collection

Sub Main()
    Dim b As TreeBuilder
    Set b = New TreeBuilder
    Set treeNodes = New VBA.Collection
    ActiveSheet.Buttons.Delete
    b.Build Selection, treeNodes
End Sub

Public Sub TreeNodeClick()
    Dim caller As String
    caller = Application.caller
    Dim treeNode As treeNode
    Set treeNode = treeNodes(caller)
    If Not treeNode Is Nothing Then
        treeNode.Click
    End If
End Sub

---

类模块树节点：

Option Explicit

Private m_button As Excel.Button
Private m_children As Collection
Private m_parent As treeNode
Private m_range As Range
Private Const Collapsed As String = "+"
Private Const Expanded As String = "-"
Private m_indentLevel As Integer

Public Sub Create(ByVal rng As Range, ByVal parent As treeNode)
On Error GoTo ErrCreate

    Set m_range = rng
    m_range.EntireRow.RowHeight = 25
    m_indentLevel = m_range.IndentLevel
    Set m_parent = parent
    If Not m_parent Is Nothing Then _
        m_parent.AddChild Me
    Set m_button = rng.parent.Buttons.Add(rng.Left + 3 + 19 * m_indentLevel, rng.Top + 3, 19, 19)
    With m_button
        .Caption = Expanded
        .Name = m_range.Address
        .OnAction = "TreeNodeClick"
        .Placement = xlMoveAndSize
        .PrintObject = False
    End With

    With m_range
        .VerticalAlignment = xlCenter
        .Value = Strings.Trim(.Value)
        .Value = Strings.String((m_indentLevel + 11) + m_indentLevel * 5, " ") & .Value
    End With

    Exit Sub

ErrCreate:
    MsgBox Err.Description, vbCritical, "TreeNode::Create"
End Sub

Public Sub Collapse(ByVal hide As Boolean)
    If hide Then
        m_range.EntireRow.Hidden = True
    End If
    m_button.Caption = Collapsed
    Dim ch As treeNode
    For Each ch In m_children
        ch.Collapse True
    Next
End Sub

Public Sub Expand(ByVal unhide As Boolean)
    If unhide Then
        m_range.EntireRow.Hidden = False
    End If
    m_button.Caption = Expanded
    Dim ch As treeNode
    For Each ch In m_children
        ch.Expand True
    Next
End Sub

Public Sub AddChild(ByVal child As treeNode)
    m_children.Add child
End Sub

Private Sub Class_Initialize()
    Set m_children = New VBA.Collection
End Sub

Public Sub Click()
    If m_button.Caption = Collapsed Then
        Expand False
    Else
        Collapse False
    End If
End Sub

Public Property Get IndentLevel() As Integer
    IndentLevel = m_indentLevel
End Property

Public Property Get Cell() As Range
    Set Cell = m_range
End Property

---

类模块 TreeBuilder：

Option Explicit

Public Sub Build(ByVal source As Range, ByVal treeNodes As VBA.Collection)
    Dim currCell As Range
    Dim newNode As treeNode
    Dim parentNode As treeNode
    For Each currCell In source.Columns(1).Cells
        Set parentNode = FindParent(currCell, source, treeNodes)
        Set newNode = New treeNode
        newNode.Create currCell, parentNode
        treeNodes.Add newNode, currCell.Address
    Next currCell
End Sub

Private Function FindParent(ByVal currCell As Range, ByVal source As Range, ByVal treeNodes As VBA.Collection) As treeNode
    If currCell.IndentLevel = 0 Then
        Exit Function
    End If
    Dim c As Range
    Dim r As Integer
    Set c = currCell
    For r = currCell.Row - 1 To source.Rows(1).Row Step -1
        Set c = c.offset(-1, 0)
        If c.IndentLevel = currCell.IndentLevel - 1 Then
            Set FindParent = treeNodes(c.Address)
            Exit Function
        End If
    Next r
End Function

---

结果：