Группировка строк в VBA

у меня есть код ниже, который, похоже, не работает. По существу,rngList относится к определенному диапазону имен в Excel, который составляет около 500 строк длиной и каждый n количество строк есть текст (есть примерно 32 строки из 500, которые имеют текст). Я пытаюсь перейти к непустым ячейкам (имитируя ctrl + down команда в Excel).

Я проверяю, пусты ли они, и если да, я хочу сгруппировать эту ячейку. Если он не пуст, я хочу проверить ячейка слева, и если она равна 0, я также хочу сгруппировать ее. Код, который у меня есть сейчас, по существу пытается сделать это, но я получаю ошибку ниже:

Group Method of Range Class Failed

затем он переходит к выделению следующей строки:

Selection.Rows.Group

EDIT: скажем, вместо группировки пустых строк я хочу сгруппировать строки, в которых есть 1. Таким образом, crtl + down фактически перейдет в эту ячейку, а не в последнюю строку.

большое спасибо за помощь!

код ниже:

rngList.Cells(1).Select
    i = 0

    Do While i < 32
        i = i + 1
        If Selection.Value = "" Then
            Selection.Rows.Group
        Else
            Selection.End(xlToLeft).Select
                If Selection.Value <> 0 Then
                    Selection.Rows.ClearOutline
                End If
        End If
        Selection.End(xlToRight).Select
        Selection.End(xlDown).Select

    Loop
6
excel excel-vba vba

2 ответов

несмотря на возраст этого поста, я думал, что брошу свои два цента для любого, кто может наткнуться на него. Надеюсь я правильно понял ваш вопрос. Вот что я понял:--7-->

цель: для каждой строки в столбце интересов, группировать строки на основе критериев.

критерии только rows in the group являются те, которые либо не имеют значения (пустой, null, пустой) или имеют значение и имеют соседнюю ячейку (непосредственно слева), которая имеет значение 0. Единственное rows not in the group это те, которые не пустой и иметь соседнюю ячейку, которая не 0.

вот некоторые примеры данных:

Примечание: серии B1:B12 макияж названный диапазон rngList, как говорит ОП.

Данные Перед Запуском Макроса:

enter image description here

Данных После Запуска Макроса - Группировка Uncollapsed:

enter image description here

Данных После Запуска Макроса - Группировка Развалилась:

enter image description here

код, который обрабатывает это:

чтобы этот код работал: в VBE (редактор Visual Basic) откройте лист, содержащий данные для группировки (также содержит именованный диапазон rngList) и вставьте этот код, затем запустите макрос.

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

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
End Sub
12

я использовал код Сэма для группировки без использования столбца A. думал, что другие могут найти его полезным.

Sub Group_Jobs()

Dim myRange As Range
Dim rowCount As Integer, currentRow As Integer
Dim firstBlankRow As Integer, lastBlankRow As Integer
Dim currentRowValue As String
Dim nextRowValue As String

Application.ScreenUpdating = False 'Stop screen updating while grouping

'select range based on given named range
Set myRange = Range("A1:A1000")
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
    nextRowValue = Cells(currentRow + 1, myRange.Column).Value

'Assign firstBlankRow & lastBlankRow
    'if currentRowValue = NotBlank(Job#) And nextRowValue = NotBlank(Job#) Then Skip
    'if currentRowValue = Blank          And nextRowValue = Blank          Then Skip
    'if currentRowValue = NotBlank(Job#) And nextRowValue = Blank          Then is firstBlankRow
    'if currentRowValue = Blank          And nextRowValue = NotBlank(Job#) Then is lastBlankRow
    If Not (currentRowValue = "" Or currentRowValue = "") Then
        If (IsEmpty(nextRowValue) Or nextRowValue = "") Then
            firstBlankRow = currentRow + 1
        End If
    ElseIf (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        If Not (IsEmpty(nextRowValue) Or nextRowValue = "") Then
            If firstBlankRow <> 0 Then
                lastBlankRow = currentRow
            End If
        End If
    End If
    Debug.Print "Row " & currentRow; ": firstBlankRow: " & firstBlankRow; ", lastBlankRow: " & lastBlankRow

'Group firstBlankRow & lastBlankRow
    'if first & last blank rows have been assigned, create a group
    If firstBlankRow <> 0 And lastBlankRow <> 0 Then
        'Debug.Print "Row: " & currentRow; ", Outline Level: " & ActiveSheet.Rows(currentRow).OutlineLevel
        If Not ActiveSheet.Rows(currentRow).OutlineLevel > 1 Then 'Ignore if last row is already grouped
            Range(Cells(firstBlankRow, myRange.Column), Cells(lastBlankRow, myRange.Column)).EntireRow.Select
            Selection.Group
        End If
        firstBlankRow = 0: lastBlankRow = 0 'reset the first/lastBlankRow values to 0
    End If
Next

Application.ScreenUpdating = True 'Start screen updating as macro is complete
End Sub
1