Сортировать диапазоны из 2 столбцов повторно в VBA

Question

С кодом ниже я мог сортировать данные (отмеченные синим фоном) из 2 столбцов на основе столбца «B».Точно так же я хочу повторить то же самое для каждого синего блока.Я выделил ячейки вручную только для иллюстрации.Любая помощь будет оценена.

Код:

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