按升序排序父级和子级

Question

I have Input in following format

And I want to sort it in ascending order first the parents then their childrens

This is the corresponding output format

I tried to use a temporary worksheet and concatenate using | as delimiter then sort it in ascending order and then split and place it in their respective cells. But in some cases like numbers it does not work.

Can anyone help with alternate solution to this.

Sub Macro()

TMP.Cells.Clear
INP.Cells.Copy TMP.Range("A1")

Dim rCount, cCount
Dim pVar
Dim i, j

With TMP

cCount = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column

rCount = .Cells.Find(What:="*", _
                After:=.Range("A1"), LookAt:=xlPart, _
                LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, MatchCase:=False).Row

For i = 1 To cCount
    pVar = ""

    For j = 1 To rCount
        If Trim(.Cells(j, i)) = "" And pVar <> "" Then
            If i > 1 Then
                If .Cells(j - 1, i - 1) = .Cells(j, i - 1) _
                    And .Cells(j - 1, i - 1) <> "" And .Cells(j - 1, i) <> "" Then

                    .Cells(j, i) = pVar

                End If
            Else
                .Cells(j, i) = pVar
            End If
        Else
            If .Cells(j, i) <> "" Then pVar = .Cells(j, i)
        End If
    Next j

Next i


Dim lCol As Long

TMP2.Cells.Clear

For i = 1 To rCount

    lCol = TMP.Cells(i, TMP.Columns.Count).End(xlToLeft).Column

    TMP2.Cells(i, 1) = ConCatRng(TMP.Range(TMP.Cells(i, 1), TMP.Cells(i, lCol)))

Next i
End With

With TMP2

    TMP2.Sort.SortFields.Clear
    TMP2.Sort.SortFields.Add Key:=.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With TMP2.Sort
        .SetRange TMP2.Range("A1:A" & rCount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End With

Dim cet, aCell As Range

OUT.Cells.Clear

For i = 1 To rCount

    cet = Split(TMP2.Cells(i, 1), "|")

    For j = LBound(cet) To UBound(cet)

        Set aCell = OUT.Range(OUT.Cells(1, j + 1), OUT.Cells(OUT.Rows.Count, j + 1)).Find(What:=cet(j), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

        If aCell Is Nothing Then OUT.Cells(i, j + 1) = cet(j)
    Next j

Next i

OUT.Activate
MsgBox "Process Completed"

End Sub

Function ConCatRng(sRng As Range)

ConCatRng = ""

Dim aCell As Range

For Each aCell In sRng
    ConCatRng = ConCatRng & aCell.Value & "|"
Next aCell

If Len(ConCatRng) > 1 Then ConCatRng = Left(ConCatRng, Len(ConCatRng) - 1)


End Function

Answer 1

Is there a reason for you put the names in this kind of layout? I ask because if you put in a simple list, you can build a Pivot Table that will generate exactly what you want or will be an easyer VBA to do it.

Veja um exemplo do meu teste