vba Excel VBA宏根据条件对行进行分组

Excel VBA macro to group rows based on condition

提问by fouraces

I am trying to create a macro that groups rows based on whether or not there is a value in column A. Some cells without a value may still have a null text string, so it would be best to use something like the length being greater than 2 as the condition for grouping rather than just blanks. The range for applying the macro would be row 3 through the last row of the data set (or if the range needs to be defined, through row 3000 would be sufficient). For example, if A4 had a value, and A10 had a value, then rows 5 through 9 should become a group. I found some code just Googling around, but I couldn't apply it right, so I'd rather just start from scratch. Thanks in advance!

我正在尝试创建一个宏，根据 A 列中是否有值来对行进行分组。一些没有值的单元格可能仍然有一个空文本字符串，因此最好使用诸如长度大于2 作为分组的条件而不仅仅是空白。应用宏的范围是数据集的第 3 行到最后一行（或者如果需要定义范围，则到第 3000 行就足够了）。例如，如果 A4 有一个值，A10 有一个值，那么第 5 行到第 9 行应该成为一个组。我发现一些代码只是在谷歌上搜索，但我无法正确应用它，所以我宁愿从头开始。提前致谢！

回答by luckyguy73

try this out works for me if the empty cells are blanks

如果空单元格是空白，试试这个对我有用

sub ashGrp()

Dim rng As Range
Dim blankRange As Range
Dim grp As Range
Set rng = Range("a3", Cells(Rows.Count, 1).End(xlUp))
Set blankRange = rng.SpecialCells(xlCellTypeBlanks)

For Each grp In blankRange
    grp.Rows.Group
Next

end sub

if you need to group either text or blanks then this union code will do the trick

如果您需要对文本或空白进行分组，则此联合代码将起作用

Sub ashGrp()

    Dim rng As Range
    Dim blankRange As Range
    Dim grp As Range
    Dim txtRange As Range
    Dim unionRange As Range

    Set rng = Range("a3", Cells(Rows.Count, 1).End(xlUp))
    Set blankRange = rng.SpecialCells(xlCellTypeBlanks)
    Set txtRange = rng.SpecialCells(xlCellTypeConstants, xlTextValues)
    Set unionRange = Union(blankRange, txtRange)

    For Each grp In unionRange
    grp.Rows.Group
    Next


End Sub

回答by ib11

You can try this. It is a narrowed down macro from this post: https://stackoverflow.com/a/14967281/6201755

你可以试试这个。这是这篇文章的缩小宏：https: //stackoverflow.com/a/14967281/6201755

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

    'select range based on given named range
    Set myRange = Range("A3:A3000")
    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

        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 firstBlankRow <> 0 Then
                'if firstBlankRow is assigned and this row has a value
                '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