将单元格值分组到基于另一个单元格值的范围

Question

我需要这些值采用以下格式：

Answer 1

尝试：

Option Explicit

Sub test()

    Dim LastRowA As Long, i As Long, StartPoint As Long, EndPoint As Long, y As Long, LastRowD As Long
    Dim arr As Variant
    Dim Char1 As String, Char2 As String

    With ThisWorkbook.Worksheets("Sheet1")

        'Find the last row of Column A
        LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        'Set the range with data
        arr = .Range("A1:A" & LastRowA)

        StartPoint = 1

            'Loop the range with data
            For i = LBound(arr) To UBound(arr)

                If StartPoint <= i Then

                    Char1 = Mid(arr(i, 1), 3, 1)

                    'Loop to find match
                    For y = i + 1 To UBound(arr)

                        Char2 = Mid(arr(y, 1), 3, 1)

                        If Char1 <> Char2 Then
                            EndPoint = y - 1
                            Exit For
                       End If

                    Next y

                    LastRowD = .Cells(.Rows.Count, "D").End(xlUp).Row

                    .Range("D" & LastRowD + 1).Value = Right(.Range("A" & StartPoint).Value, (Len(.Range("A" & StartPoint).Value) - 1)) & " - " & Right(.Range("A" & EndPoint).Value, (Len(.Range("A" & EndPoint).Value) - 1))

                    StartPoint = y

                End If

            Next i

    End With

End Sub

结果：