用于分组行的macros

我目前有一个macros组合空白单元格，并忽略单元格中的值，我不知道如何改变它，所以它是与特定的值（准确地说，150,155,130,115和110）分组。

我的问题是我如何更改代码，以便分组空单元而不是分组单元格中的值。

所以我想要这个

看起来像这样

澄清macros是什么：

它贯穿每个细胞，并检查价值。 如果它有价值，那么它跳到下一个单元格。 如果单元格没有任何价值，它将检查下一个单元格，如果发生同样的情况，则将这些单元格分组在一起

码：

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 Rows("1:2000").RowHeight = 15 Columns("A:N").ColumnWidth = 13 'select range based on given named range Set myRange = Range("A7:A2000") 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 firstBlankRow = 0 Then firstBlankRow = currentRow End If ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue = "") Then If firstBlankRow = 0 Then firstBlankRow = currentRow ElseIf firstBlankRow <> 0 Then lastBlankRow = currentRow - 1 End If End If 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 

Answer 1

这应该做到这一点。 您可以修改它以适应更详细的条件等：

 Option Explicit Sub Macro1() Dim bBreak As Boolean Dim i As Long Dim lRow As Long Dim rng As Range Dim cell As Range Dim WS As Worksheet Dim dict As Object Set WS = ActiveSheet 'I assume the values are in column A With WS lRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With 'Define a dictionary to store values that should be grouped Set dict = CreateObject("scripting.dictionary") dict.Add 150, "" dict.Add 155, "" dict.Add 130, "" dict.Add 115, "" dict.Add 110, "" 'Loop through the values in Column A and group them For i = 1 To lRow Set cell = WS.Cells(i, 1) If dict.exists(cell.Value) Then 'cell value is among values store in the dict, so it should be grouped If rng Is Nothing Then Set rng = cell 'first cell with a value to be grouped Else Set rng = Application.Union(rng, cell) End If Else 'cell is a breaker value If rng Is Nothing Then 'there is nothing to be grouped, continue 'do nothing Else 'this is the last cell of a range that should be grouped rng.Rows.Group 'group only rows Set rng = Nothing 'reset the range End If End If Next i 'If the last cell is not a breaker, the last cells will not be grouped If Not rng Is Nothing Then rng.Rows.Group 'group only rows End If End Sub