excel - 在 Excel 中对具有相似值的行进行分组

Question

我有一个表，第一列包含一些数字，我想循环并根据第一列中的值对表的行进行分组，以便它们可以折叠。与 shift+alt+right 的作用非常相似。作为一个例子，我想用这样的行转换一个表

1

1

2

3

3

3

进入这样的表格，每个分组都是可扩展的并且在同一级别上。

1

2

3

我一直在尝试更改从https://superuser.com/questions/867796/excel-macro-to-group-rows-based-on-a-cell-value找到的宏。我现在的宏是...

Dim LastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
Dim StartRow As Integer
StartRow = 8

groupBegin = StartRow 'For the first group
For i = StartRow To LastRow

    If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
        groupEnd = i - 1
        Rows(groupBegin & ":" & groupEnd).Select
        Selection.Rows.Group
        groupBegin = i + 1 'adding one to keep the group's first row
    End If

Next i

Rows(groupBegin & ":" & LastRow).Select
Selection.Rows.Group

ActiveSheet.Outline.ShowLevels RowLevels:=1 'Minimize all the groups

但是，这会将所有行组合在一起。任何有关如何实现这一目标的指导将不胜感激。

标签： excelvba

Answer 1

下面是执行任务的代码。请注意，代码假定数字已排序并且行之间没有空格。

Sub Group_Similar_Rows()

Dim i As Long
Dim lRef_Number As Long
Dim lNumber As Long
Dim lCount As Long
Dim lStarting_Row As Long
Dim lDate_Column As Long
Dim wks As Worksheet

lStarting_Row = 1 ' Change this to the starting row of your data
lDate_Column = 1 ' Chnage this to the column index of your data

Set wks = ThisWorkbook.ActiveSheet

lRef_Number = wks.Cells(lStarting_Row, lDate_Column)

lCount = -1
For i = 0 To 100000 ' if your data entry is more than 100,000 increase this the value
    
    If wks.Cells(lStarting_Row + i, lDate_Column) = "" And lCount <= 0 Then
        Exit For
    End If
    
    lCount = 1 + lCount
    lNumber = wks.Cells(lStarting_Row + i, lDate_Column)
    
    If lNumber <> lRef_Number Then
    
        lRef_Number = wks.Cells(lStarting_Row + i, lDate_Column)
        
        If i > 1 Then
            lCount = lCount - 1
        End If
        
        If lCount > 0 Then
            lCount = 1 + lCount
            wks.Rows(lStarting_Row + i - lCount & ":" & lStarting_Row + i - 2).Group
        
        End If
        
        lCount = 0
        
    End If

Next i

End Sub

下图显示了运行代码的结果：