问在Excel中使用重复数据创建行

EN

Sub GroupByCommonValue()

    Dim rng_all As Range
    Set rng_all = Intersect(Range("B:B"), ActiveSheet.UsedRange)

    Dim rng_data As Range
    Set rng_data = Intersect(rng_all, rng_all.Offset(1))

    'create output sheet
    Dim sht_out As Worksheet
    Set sht_out = Worksheets.Add()
    sht_out.Range("A1") = "GROUP"
    sht_out.Range("B1") = "IDs"

    Dim rng_out As Range
    Set rng_out = sht_out.Range("A2")

    Dim rng As Range
    For Each rng In rng_data
        'skip duplicates
        If Application.WorksheetFunction.CountIf(rng_out.EntireColumn, rng.Value) = 0 Then

            rng_all.AutoFilter Field:=1, Criteria1:=rng.Value

            Dim arr As Variant
            arr = rng_data.Offset(, -1).SpecialCells(xlCellTypeVisible).Value

            rng_out = rng.Value

            If TypeName(arr) <> "Variant()" Then
                rng_out.Offset(, 1) = arr
            Else
                arr = Application.Transpose(arr)

                'top line will concatenate / lower will create column for each
                rng_out.Offset(, 1) = Join(arr, ", ")
                'rng_out.Offset(, 1).Resize(1, UBound(arr)).Value = arr
            End If

            Set rng_out = rng_out.Offset(1)
        End If
    Next

    rng_all.Parent.AutoFilterMode = False
End Sub