Excel vba - группировать строки между пробелами

Question

Имейте в виду, первый вопрос, который я задал здесь.

Я пытаюсь сгруппировать строки в контур между пустыми строками промежуточных итогов при извлечении необработанных данных в рамках более крупного процесса форматирования.

Пример данных будет выглядеть (извините, все еще новый пользователь, нельзя просто вставлять, насколько я могу судить.): Пример данных Пример результата

Отрабатывал ответы, которые я нашел в Группировка строк в VBA

Public Sub GroupCells()
Dim myRange As Range
Dim rowCount As Integer, currentRow As Integer
Dim firstBlankRow As Integer, lastBlankRow As Integer
Dim currentRowValue As String
Dim neighborColumnValue As String

'select range based on given named range
Set myRange = Range("rngList")
rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

firstBlankRow = 0
lastBlankRow = 0
'for every row in the range
For currentRow = 1 To rowCount
    currentRowValue = Cells(currentRow, myRange.Column).Value
    neighborColumnValue = Cells(currentRow, myRange.Column - 1).Value

    If (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        'if cell is blank and firstBlankRow hasn't been assigned yet
        If firstBlankRow = 0 Then
            firstBlankRow = currentRow
        End If
    ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        'if the cell is not blank and its neighbor's (to the left) value is 0,
        'and firstBlankRow hasn't been assigned, then this is the firstBlankRow
        'to consider for grouping
        If neighborColumnValue = 0 And firstBlankRow = 0 Then
            firstBlankRow = currentRow
        ElseIf neighborColumnValue <> 0 And firstBlankRow <> 0 Then
            'if firstBlankRow is assigned and this row has a value with a neighbor
            'who isn't 0, then the cell one row above this one is to be considered
            'the lastBlankRow to include in the grouping
            lastBlankRow = currentRow - 1
        End If
    End If

    'if first AND last blank rows have been assigned, then create a group
    'then reset the first/lastBlankRow values to 0 and begin searching for next
    'grouping
    If firstBlankRow <> 0 And lastBlankRow <> 0 Then
        Range(Cells(firstBlankRow, myRange.Column), Cells(lastBlankRow, myRange.Column)).EntireRow.Select
        Selection.Group
        firstBlankRow = 0
        lastBlankRow = 0
    End If
Next

Он группирует пустые ячейки вместе, но мне нужно выяснить, как заставить lastBlankRow подобратьследующая пустая строка после следующего блока данных.

Заранее спасибо!

Answer 1

Этого можно добиться гораздо меньшим количеством кода, используя цикл Do While, вложенный в For-Next и сохраняя количество непустых ячеек в столбце B, группируя их по этому количеству - 1, а затем добавляя это число к вашему.итерация.

Протестировано с воссозданием вашей структуры данных и достигнуты желаемые результаты:

Sub GroupRows()

    Dim r As Long
    Dim i As Long
    Dim rowCount As Long

    rowCount = Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To rowCount
        r = 0
        Do While Range("B" & i + r) <> "" And Not IsEmpty(Range("B" & i + r))
            r = r + 1
        Loop
        Range("B" & i & ":B" & i + r - 1).Rows.Group
        i = i + r
    Next i

End Sub