excel - 使用列标题和子标题填充 TreeView

Question

我是 TreeView 控件的新手，想用标题列作为父节点和子标题作为子节点填充我的 TreeView(两列)，如图所示:



我从以下代码开始，但我坚持使用它:

Sub UserForm_Initialize()

    Dim WB As Workbook
    Dim WS As Worksheet
    Dim HeaderRng As Range
    Dim rng As Range
    Dim rCell As Range
    Dim i As Long
    Dim Nod As Node

    Set WB = ThisWorkbook
    Set WS = WB.Worksheets("Data")
    Set HeaderRng = WS.Range("A1:M1")

    With Me.TreeView1.Nodes
        .Clear
        For Each rCell In HeaderRng
            .Add Key:=rCell.Value, Text:=rCell.Value
        Next rCell
    End With

    TreeView1.CheckBoxes = True
    TreeView1.Style = tvwTreelinesPlusMinusText
    TreeView1.BorderStyle = ccFixedSingle

End Sub

Answer 1

感谢您向我介绍 TreeView!借助 article ，我已经让它在你的条件下工作。

设计 View |执行用户表单:


代码(已更新以适应 HeaderRng 中的乱序组):

Option Explicit

Sub UserForm_Initialize()
    With Me.TreeView1
        .BorderStyle = ccFixedSingle
        .CheckBoxes = True
        .Style = tvwTreelinesPlusMinusText
        .LineStyle = tvwRootLines
    End With

    UpdateTreeView
End Sub

Private Sub UpdateTreeView()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim HeaderRng As Range
    Dim rng As Range
    Dim sCurrGroup As String
    Dim sChild As String
    Dim oNode As Node

    Set WB = ThisWorkbook
    Set WS = WB.Worksheets("Data")
    With WS ' Row A are Header/Groups
        Set HeaderRng = Intersect(.Rows(1), .UsedRange)
    End With

    With Me.TreeView1
        With .Nodes
            '.Clear
            sCurrGroup = ""
            For Each rng In HeaderRng
                'Debug.Print "rng: " & rng.Address & " | " & rng.Value
                sCurrGroup = rng.Value
                ' Add Node only if it does NOT exists
                Set oNode = Nothing
                On Error Resume Next
                Set oNode = .Item(sCurrGroup)
                If oNode Is Nothing Then
                    'Debug.Print "Adding Group: " & sCurrGroup
                    .Add Key:=sCurrGroup, Text:=sCurrGroup
                End If
                On Error GoTo 0

                ' Add the Child below the cell
                sChild = rng.Offset(1, 0).Value
                'Debug.Print "Adding [" & sChild & "] to [" & sCurrGroup & "]"
                .Add Relative:=sCurrGroup, Relationship:=tvwChild, Key:=sChild, Text:=sChild
            Next
        End With
        For Each oNode In .Nodes
            oNode.Expanded = True
        Next
    End With

    Set HeaderRng = Nothing
    Set WS = Nothing
    Set WB = Nothing
End Sub