Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
688 views
in Technique[技术] by (71.8m points)

vba - Build a tree like representation of data in Excel?

I have a bunch of raw data in this fashion:

Parent  |  Data
---------------
Root    | AAA
AAA     | BBB
AAA     | CCC
AAA     | DDD
BBB     | EEE
BBB     | FFF
CCC     | GGG
DDD     | HHH

Which needs to be converted into a tree like fashion. This basically needs to end up in an excel spreadsheet. How can I convert the above data into the following:

AAA |      |
    | BBB  |
    |      | EEE
    |      | FFF
    | CCC  |
    |      | GGG
    | DDD  |
    |      | HHH

Is there any easy way to do this using only VBA?

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

I'm sure you can tidy this up, but this will work on the data set you've provided.

Before you start, you will need to define two Names (Insert / Name / Define). "Data" is the range of your dataset, "Destination" is the spot where you want the tree to go.

Sub MakeTree()

    Dim r As Integer
    ' Iterate through the range, looking for the Root
    For r = 1 To Range("Data").Rows.Count
        If Range("Data").Cells(r, 1) = "Root" Then
            DrawNode Range("Data").Cells(r, 2), 0, 0
        End If
    Next

End Sub

Sub DrawNode(ByRef header As String, ByRef row As Integer, ByRef depth As Integer)
'The DrawNode routine draws the current node, and all child nodes.
' First we draw the header text:
    Cells(Range("Destination").row + row, Range("Destination").Column + depth) = header

    Dim r As Integer
    'Then loop through, looking for instances of that text
    For r = 1 To Range("Data").Rows.Count
        If Range("Data").Cells(r, 1) = header Then
        'Bang!  We've found one!  Then call itself to see if there are any child nodes
            row = row + 1
            DrawNode Range("Data").Cells(r, 2), row, depth + 1
        End If
    Next
End Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...