使用列标题和子标题填充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

感谢您介绍我的知识树视图！ 在这篇文章的帮助下，我已经掌握了你的条件。

devise视图| 执行的用户表单：

代码（已更新，以适应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