在VBA中从2列重复排序范围

Question

使用以下代码，我可以基于“ B”列从2列对数据（带有蓝色背景标记）进行排序。同样，我想对每个蓝色块重复相同的操作。我手动突出显示了单元格只是为了说明。任何帮助将不胜感激。

代码：

Sub SortRanges()
Dim firstcell As String
With Columns("B")
    .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).Activate
    firstcell = ActiveCell.Row

End With

    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    ActiveWorkbook.Worksheets("Sheet4").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Sheet4").Sort.SortFields.Add Key:=Range("B" & firstcell & ":B" & firstcell + 5), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet4").Sort
        .SetRange Range("A" & firstcell & ":B" & firstcell + 5)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Answer 1

尝试遍历您的专栏，然后看起来一切都是5块，因此请执行以下操作：

lr = cells(rows.count,1).end(xlup).row
For i = 1 to lr 
    if cells(i,1).interior.color = Blue Then `FIX THIS TO MATCH THE BLUE YOU WANT
        Range(Cells(i,1),Cells(i+5,2)).Sort key1:=Range(Cells(i,2),Cells(i+5,2)), order1:=xlAscending, Header:=xlNo
        i=i+5
    End if
next i

---

我可能不了解有关突出显示的部分...如果蓝色是“突出显示”，那么您可以对上面的内容进行修改，以便：

lr = cells(rows.count,1).end(xlup).row
For i = 1 to lr 
    if not isempty(cells(i,2)) Then
        Range(Cells(i,1),Cells(i+5,2)).Sort key1:=Range(Cells(i,2),Cells(i+5,2)), order1:=xlAscending, Header:=xlNo
        i=i+5
    End if
next i

---

还有一件事情...如果您可以按顺序运行2种排序，那么第二种应该是您的最终排序，例如：

lr = cells(rows.count,1).end(xlup).row
For i = 1 to lr 
    if not isempty(cells(i,2)) Then
        Range(Cells(i,1),Cells(i+5,2)).Sort key1:=Range(Cells(i,1),Cells(i+5,1)), order1:=xlAscending, Header:=xlNo
        Range(Cells(i,1),Cells(i+5,2)).Sort key1:=Range(Cells(i,2),Cells(i+5,2)), order1:=xlAscending, Header:=xlNo
        i=i+5
    End if
next i