Excel VBAmacros根据条件对行进行分组

我正在尝试创build一个macros,根据A列中是否有值来对行进行分组。某些没有值的单元格可能仍然有一个空文本string,所以最好使用类似于长度大于2作为分组的条件,而不仅仅是空白。 应用macros的范围将是第3行到数据集的最后一行(或者如果需要定义范围,则通过行3000就足够了)。 例如,如果A4有一个值,而A10有一个值,则第5行到第9行应该成为一个组。 我发现一些代码只是谷歌search,但我不能正确应用,所以我宁愿从头开始。 提前致谢!

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

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 

如果你需要将文本或空白组合,那么这个联合代码就可以做到这一点

 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 

你可以试试这个 这是一个缩小的macros从这个职位: 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