Question

我的数据在分组方案中分为三个连续类别，如下所示：

所以整个团队＆＃34; OCM＆＃34;被分解为名为＆＃34; N / A＆＃34;，＆＃34;财务＆＃34;，＆＃34;工业＆＃34;等等，每个都被分解成更多的子组。

我在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

一种可能性是向每个单元格添加一个按钮，并在折叠上隐藏其子行，并在展开上显示其子行。

每个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

类模块TreeNode：

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

结果：

折叠/展开部分中的行

2 个答案: