答案 0 :(得分:5)
试试这个
Sub demo()
Dim r As Range
Dim v As Variant
Dim i As Long, j As Long
With ActiveSheet
On Error Resume Next
' expand all groups on sheet
.Outline.ShowLevels RowLevels:=8
' remove any existing groups
.Rows.Ungroup
On Error GoTo 0
Set r = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp))
End With
With r
'identify common groups in column B
j = 1
v = .Cells(j, 1).Value
For i = 2 To .Rows.Count
If v <> .Cells(i, 1) Then
' Colum B changed, create group
v = .Cells(i, 1)
If i > j + 1 Then
.Cells(j + 1, 1).Resize(i - j - 1, 1).Rows.Group
End If
j = i
v = .Cells(j, 1).Value
End If
Next
' create last group
If i > j + 1 Then
.Cells(j + 1, 1).Resize(i - j - 1, 1).Rows.Group
End If
' collapse all groups
.Parent.Outline.ShowLevels RowLevels:=1
End With
End Sub