VBA中基于父子的范围排序

Question

我有以下数据表：

如你所见，我有5个父母，每个父母都有自己的子树/范围。我想重新订购这些父/子树，给定另一张表中的父顺序关联。我的逻辑是迭代行直到我看到另一个父，选择范围，并将其存储在与总行和范围长度成比例的索引的某个临时范围内。订单关联表看起来像：

我正在考虑将这个新订单存储在我想要的工作表中的一些临时列中，覆盖原始列然后清除临时列，但这似乎效率低下，而且我不确定如何在VBA中有效地实现此逻辑，或者如果有更简单的逻辑。任何帮助，将不胜感激。

逻辑实施：

i = 2
While ThisWorkbook.Sheets("Formatting").Cells(i, 3) <> ""
looking = 0
j = 8
While ThisWorkbook.Sheets("Weights").Cells(j, 3) <> ""
    If ThisWorkbook.Sheets("Weights").Cells(j, 3) = ThisWorkbook.Sheets("Formatting").Cells(i, 3) Then
        start_row = j
        looking = 1
    End If
    If looking = 1 And ThisWorkbook.Sheets("Weights").Cells(j, 3) <> ThisWorkbook.Sheets("Formatting").Cells(i, 3) Then
        end_row = j - 1
    End If
Wend
ThisWorkbook.Sheets("Weights").Range("start_row:end_row").Cut
ThisWorkbook.Sheets("Weights").Range("1:1").Insert
Wend

Answer 1

按“订单”列按降序对订单关联表进行排序。

这是伪代码，因为我假设你已经有大部分代码了。

Loop through your Order Association table
    Set state to Looking
    Loop through the rows of the Root table
        If Root Name matches Association Name
            Remember the row (Start Row)
            Set state to Not Looking
        endif
        if State is Not Looking and Root Name does not match Association Name
            Remember the previous row (End Row)
        endif
    End Loop
    Range(Start Row:End Row).Cut
    Range("1:1").Insert
End Loop

好吧，事实证明这比我想象的要复杂一点，但这适用于我的样本数据：

Sub SortWeights()

    Dim formatRow As Integer        ' Current row in ordered list of parents
    Dim weightRow As Integer        ' Current row while sorting weights
    Dim startRow As Integer         ' First row in weights group
    Dim endRow As Integer           ' Last row in weights group
    Dim weightsSheet As Worksheet   ' Worksheet containing weights
    Dim formatSheet As Worksheet    ' Worksheet containing ordered parent weights
    Dim looking As Boolean          ' True while gathering child rows
    Dim doShift As Boolean          ' True if weights group needs to be moved
    Dim candidate As Range          ' Candidate weight
    Dim sortingWeight As Range      ' Reformatted sorting weight name

    Const firstFormatRow As Integer = 1     'First row in ordered list of parents
    Const lastFormatRow As Integer = 3      'Last row in ordered list of parents
    Const firstWeightRow As Integer = 1     'First row in list of weights to be sorted
    Const lastWeightRow As Integer = 8      'Last row in list of weights to be sorted
    Const weightNameColumn As Integer = 3   'Column with parent names to be sorted
    Const formatNameColumn As Integer = 3   'Column with parent names in ascending order

    Set weightsSheet = ActiveWorkbook.Sheets("Weights")
    Set formatSheet = ActiveWorkbook.Sheets("Formatting")

    formatRow = lastFormatRow

    ' Loop through the list of ordered parent weights
    Do Until formatRow < firstFormatRow

        ' Reset everything
        looking = False
        doShift = False
        startRow = 0
        endRow = 0
        Set sortingWeight = formatSheet.Cells(formatRow, formatNameColumn)

        ' Loop through the list of all weights
        For weightRow = firstWeightRow To lastWeightRow

            Set candidate = weightsSheet.Cells(weightRow, weightNameColumn)

            ' If match found, start counting
            If candidate.Value = sortingWeight.Value Then
                ' If the match is in the first row, it is already in place, skip it.
                If weightRow = 1 Then
                    Exit For
                Else
                    startRow = weightRow
                    looking = True
                    doShift = True
                End If
            End If

            ' If gathering children...
            If looking Then
                ' If this is the last row, it is the end of the group.
                If weightRow = lastWeightRow Then
                    endRow = weightRow
                ' Otherwis, if this is a new group, the previous row was the end.
                ElseIf candidate.IndentLevel = 0 And candidate <> sortingWeight Then
                    endRow = weightRow - 1
                    Exit For
                End If
            End If

        Next weightRow

        ' Only do the cut and insert if necessary
        If doShift Then
            weightsSheet.Range(CStr(startRow) & ":" & CStr(endRow)).Cut
            weightsSheet.Range(CStr(firstWeightRow) & ":" & CStr(firstWeightRow)).Insert
        End If

        ' Do the next parent.
        formatRow = formatRow - 1

    Loop

End Sub

您需要更新常量以匹配工作表中的任何内容。如果需要，您可以使常量变量并使用工作表对象的UsedRange属性来设置这些值（如果需要）。这会更有活力，但我认为这超出了这个问题的范围。

让我知道事情的后续。希望它能让你到达你需要的地方。