在部分中折叠/展开行
我有这样的分组scheme中的数据分成三个连续的类别：
因此，整个组织“OCM”被分解为“N / A”，“金融”，“工业”等小组，分别被分成更多小组。
我在Excel中有相同的数据，但不幸的是它自动格式化如下：
所有的东西都被扩大了，而不是分组，所以只有一个空间来指示一个新的子组开始。
数据延伸到数千行，所以手工分组是不可能的。 有没有另一种方法来自动分组数据，其中一个空格表示一个子组？
编辑
Function indenture(r As Range) As Integer indenture = r.IndentLevel End Function 然后nodeOrd = Sheet1.Range("A" & i).IndentLevel返回正确的缩进级别。
解决scheme1 – 使用组
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
解决scheme2 – 如果您不想修改工作簿数据 – 解决方法
第1步 – 创build一个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
结果
一种可能性是将一个button添加到每个单元格，并在折叠时隐藏它的子行，并展开其子行。
每个Excel.Button执行一个常见的方法TreeNodeClick ，在TreeNodeClick的相应实例上调用Click方法。 子行被隐藏或显示基于button的实际标题。
开始时，执行Main方法时需要select源数据范围。 问题是每次打开表单时都需要填充树节点的集合。 所以方法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
结果：
