按值

时间:2016-01-16 07:14:47

标签: excel-vba excel-2010 vba excel

如何按列B中的值以编程方式对以下数据进行分组?

请注意,列AC中存在随机值。

enter image description here

像这样:

enter image description here - > enter image description here

1 个答案:

答案 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