在VBA中对行进行分组

Question

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

我正在检查它们是否为空白，如果是，我想将该单元格分组。如果它不是空白，我想检查左边的单元格，如果它是0，我也想将它分组。我现在的代码基本上是尝试这样做，但我收到以下错误：

Group Method of Range Class Failed

然后继续强调以下一行：

Selection.Rows.Group

编辑：假设不是将空行分组，而是要对其中包含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

Answer 1

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

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

标准：唯一的rows in the group是那些没有值（空白，空，空）或者具有值且具有相邻单元格（直接在左侧）的rows not in the group值为0.唯一的B1:B12是那些不空白并且具有不 0的相邻单元格。

以下是一些示例数据：

  

注意：范围rngList构成指定范围rngList，就像OP所说的那样。

运行宏之前的数据：

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

运行宏后的数据 - 分组崩溃：

处理此问题的代码：

要使此代码正常工作：在VBE（Visual Basic编辑器）中，打开包含要分组的数据的工作表（还包含命名范围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 ）并粘贴此代码，然后运行宏。 / p>

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

{{1}}

Answer 2

我使用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