Сортировка в порядке возрастания родительских и дочерних - PullRequest
Новая
       2

Сортировка в порядке возрастания родительских и дочерних

0 голосов
/ 22 февраля 2020

У меня есть входные данные в следующем формате

Sample Input

И я хочу отсортировать их в порядке возрастания сначала по родителям, а затем по своим детям

Это соответствующий выходной формат

enter image description here

Я попытался использовать временную таблицу и объединить, используя | затем в качестве разделителя сортируйте его в порядке возрастания, а затем разделяйте и размещайте в соответствующих ячейках Но в некоторых случаях, таких как числа, это не работает.

Может кто-нибудь помочь с альтернативным решением этой проблемы. 

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

1 Ответ

0 голосов
/ 22 февраля 2020

Есть ли причина, по которой вы помещаете имена в этот вид макета? Я спрашиваю, потому что, если вы добавите простой список, вы можете создать сводную таблицу, которая будет генерировать именно то, что вы хотите, или будет более простым VBA, чтобы сделать это. 1004 *

...