在 VBA 中对行进行分组

Grouping Rows in VBA

提问by Max_1234

I have the code below that doesn't seem to be working. Essentially, rngListrefers to a defined name range in Excel that is about 500 rows long and every nnumber of rows there is text (there are approximately 32 rows out of the 500 that have text). I am trying to go to the non-blank cells (by mimicking the ctrl + downcommand in Excel).

我有下面的代码似乎不起作用。本质上，rngList是指在 Excel 中定义的名称范围，该范围大约有 500 行，每n行都有文本（500 行中大约有 32 行有文本）。我正在尝试转到非空白单元格（通过模仿ctrl + downExcel 中的命令）。

I am checking to see if they are blank, and if they are I want to group that cell. If it is not blank, I want to check the cell to the left and if it is 0, I also want to group it. The code I have now is essentially trying to do this but I am receiving the error below:

我正在检查它们是否为空白，如果是，我想对该单元格进行分组。如果不是空白，我想检查左边的单元格，如果它是0，我也想把它分组。我现在拥有的代码基本上是在尝试执行此操作，但我收到以下错误：

Group Method of Range Class Failed

Group Method of Range Class Failed

It then goes on to highlight the following line:

然后继续突出显示以下行：

Selection.Rows.Group

Selection.Rows.Group

EDIT: Let's say instead of grouping rows that are blank, I want to group rows that have 1 in them. That way the crtl + down will actually go to that cell rather than the last row.

编辑：假设不是对空白行进行分组，而是对其中包含 1 的行进行分组。这样 crtl + down 实际上会转到那个单元格而不是最后一行。

Thank you very much for the help!

非常感谢你的帮助！

The code is below:

代码如下：

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

回答by StoriKnow

Despite the age of this post, I thought I'd throw in my two cents for anyone who might stumble upon it. I hope I understand your question correctly. Here's what I've gathered:

尽管这篇文章已经很旧了，但我想我会为任何可能偶然发现它的人投入两分钱。我希望我能正确理解你的问题。这是我收集的内容：

Goal: For every row in the column of interest, group rows based on a criteria.

目标：对于感兴趣的列中的每一行，根据标准对行进行分组。

Criteria: The only rows in the groupare those that either have no value (blank, null, empty) OR have a value AND have a neighboring cell (directly to the left) that has a value of 0. The only rows not in the groupare those that are notblank and have a neighboring cell that is not0.

标准：唯一的rows in the group是那些没有值（空白、空、空）或有值且具有值为 0 的相邻单元格（直接向左）的那些。唯一的rows not in the group是那些不是空白且有不为0的相邻单元格。

Here is some sample data:

以下是一些示例数据：

Note:the Range B1:B12makeup the named range rngList, like the OP says they have.

注意：RangeB1:B12构成了命名的 range rngList，就像 OP 所说的那样。

Data Before Running Macro:

运行宏前的数据：

Data After Running Macro - Grouping Uncollapsed:

运行宏后的数据 - 分组未折叠：

Data After Running Macro - Grouping Collapsed:

运行宏后的数据 - 分组折叠：

The code that handles this:

处理这个的代码：

To make this code work: In the VBE (Visual Basic Editor), open the worksheet that contains the data to group (also contains the named range rngList) and paste this code, then run the macro.

要使此代码起作用：在 VBE（Visual Basic 编辑器）中，打开包含要分组的数据（也包含命名范围rngList）的工作表并粘贴此代码，然后运行宏。

Note: The comments are added to explain certain parts in further detail, though I believe the code itself is written in a way that can explain itself (e.g. variable names are meaningful and logic makes sense).

注意：添加注释是为了更详细地解释某些部分，尽管我相信代码本身是以一种可以自我解释的方式编写的（例如，变量名是有意义的，逻辑是有意义的）。

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

回答by Cuinn Herrick

I have used Sam's code to group without using column A. Thought others could find it useful.

我使用 Sam 的代码进行分组而不使用 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