vba - 在 VBA 中对行进行分组

Question

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

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

Range类的Group方法失败

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

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

尽管这篇文章已经发布了很长时间，但我想我应该为任何可能偶然发现它的人贡献我的两分钱。我希望我正确理解你的问题。以下是我收集的内容:

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

条件:组中唯一的行是那些没有值(空白、null、空)或有值且具有相邻单元格(直接左侧)，其值为 0。唯一不在组中的行是那些不为空白并且具有不<的相邻单元格的行/em>0.

这里是一些示例数据:

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

运行宏之前的数据:

运行宏后的数据 - 分组展开:

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

处理此问题的代码:

要使此代码起作用:在 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