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属性设置这些值。这会更加动态，但是我认为这超出了这个问题的范围。

让我知道如何进行。希望它能带您到需要的地方。

VBA中基于父子范围的范围排序

1 个答案: