Sub Мак1()
Dim m As Integer, Tex As String
For Each I In Range(Cells(2, "c"), Cells([a1].CurrentRegion.Rows.Count, "c")) 'Цикл по строкам
    МассивСимволовСтроки = Split(I.Value, ", ") 'Создание из строки с символами массива элементов
    k = UBound(МассивСимволовСтроки) + 1
    ReDim ОпорныйМассив(k), РабочийМассив(k + 1) As Integer
    m = 1
    For Each x In МассивСимволовСтроки 'Отделение цифровой части от символов
        If x Like "*#" Then Ц = CInt(Right(x, 1))
        If x Like "*##" Then Ц = CInt(Right(x, 2))
        If x Like "*###" Then Ц = CInt(Right(x, 3))
        If x Like "*####" Then Ц = CInt(Right(x, 4))
        ОпорныйМассив(m) = Ц: РабочийМассив(m) = Ц 'Создание двух рабочих массивов
        m = m + 1
    Next x
    For x = 1 To k 'Обработка рабочих массивов первым шагом
        If РабочийМассив(x + 1) - ОпорныйМассив(x) < 0 Then РабочийМассив(x + 1) = -1 'Метка конечного элемента
        If РабочийМассив(x + 1) - ОпорныйМассив(x) = 1 Then РабочийМассив(x + 1) = 0 Else РабочийМассив(x) = ОпорныйМассив(x) 'Основная логика
    Next x
    Tex = Empty
    For x = 1 To k ''Обработка рабочих массивов вторым шагом и формирование выходного текста
       If РабочийМассив(x) <> 0 And РабочийМассив(x + 1) = 0 Then Liter = МассивСимволовСтроки(x - 1) & "..."
       If РабочийМассив(x) = 0 And РабочийМассив(x + 1) = 0 Then Liter = Empty
       If РабочийМассив(x) <> 0 And РабочийМассив(x + 1) <> 0 Then Liter = МассивСимволовСтроки(x - 1) & ", "
       If РабочийМассив(x) <> 0 And РабочийМассив(x + 1) = -1 Then Liter = МассивСимволовСтроки(x - 1)
       Tex = Tex & Liter
    Next x
'ВЫВОД НА ЛИСТ
Cells(I.Row, "c") = Tex
Next I
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
m = Cells(Target.Row, 1).End(xlDown).Row
If Cells(Target.Row, 1) <> Empty And Target.Column = 2 Then
    If Range(Cells(Target.Row + 1, 1), Cells(m - 1, 1)).Rows.EntireRow.Hidden = True Then
        Range(Cells(Target.Row + 1, 1), Cells(m - 1, 1)).Rows.EntireRow.Hidden = False
    Else
        Range(Cells(Target.Row + 1, 1), Cells(m - 1, 1)).Rows.EntireRow.Hidden = True
    End If
End If
End Sub