Дублирование строк по условию в ячейке конкретного столбца

[firestarter]

Доброго времени суток и всех с новым годом!

Прошу помощи специалистов в решении вопроса.

Есть таблица вида:

A	B	C	D	E
100	01	word1	word2	word3
101	01+02	word4	word5	word6
102	01+02+03	word7	word8	word9

Есть 2 условия.
1. Нужно полностью "повторить" (продублировать) строчки, где в ячейках столбца "B" содержится знак "+". Причем количество повторений строки = количеству знаков "+" в столбце "B".
2. При этом, в каждой продублированной строчке, в столбце "B" должно остаться только одно не повторяющееся значение (без "+").

A	B	C	D	E
100	01	word1	word2	word3
101	01	word4	word5	word6
101	02	word4	word5	word6
102	01	word7	word8	word9
102	02	word7	word8	word9
102	03	word7	word8	word9

Количество "+" в столбце "B", обычно, не превышает 3-х, но бывает и 4.


Нехитрый код неспециалиста-любителя сейчас выглядит вот так:

Код: (vb)

Sub ppp()
    Dim kLastRow As Long
    Dim k As Long

    kLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    'Up from last not empty cell to row 2
    For k = kLastRow To 2 Step -1

        If Cells(k, "B") Like "*+*" Then
            Rows(k).Select
            Selection.Copy
            Rows(k).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If

        If Cells(k, "B") Like "*+*+*" Then
            Rows(k).Select
            Selection.Copy
            Rows(k + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    Next k

    Columns("B:B").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="=""+""", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

Здесь с самого низа столбца "B" ищется знак "+", строки копируются по количеству "+" и.... практически всё. Еще подкрашиваются повторяющиеся значения, где в столбце "B" имеется "+" - для ручной доработки.
"Код" выполняется долго, и не удаляются "повторяющиеся" значения.

Помогите пожалуйста допилить обработку.

Заранее БЛАГОДАРЮ!

[firestarter]

Всем привет!

Вопрос решил своими силами, но прошу помощи в оптимизации кода.
Думается, что оно может работать быстрее.

Код: (vb)

'find last not empty cell in "B"
    kLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
'Up from last not empty cell to row 2
    For k = kLastRow To 2 Step -1
        
 'if cells in B have "*+*" - add 1 rows
        If Cells(k, "B") Like "*+*" Then
            Rows(k).Select
            Selection.Copy
            Rows(k).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
        
'if cells in B have "*+*+*" - 2 rows
        If Cells(k, "B") Like "*+*+*" Then
            Rows(k).Select
            Selection.Copy
            Rows(k + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
        
'if cells in B have "*+*+*+*" - 3 rows
        If Cells(k, "B") Like "*+*+*+*" Then
            Rows(k).Select
            Selection.Copy
            Rows(k + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If

    Next k

' Delete "+..+" in Column "B"

     Dim n1 As Long, n2 As Long

'find last not empty cell in "B"
    jLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
'Up from last not empty cell to row 2
    For j = jLastRow To 2 Step -1
        
        n1 = InStr(1, Cells(j, "B"), "+")
        n2 = InStr(n1 + 1, Cells(j, "B"), "+")
        n3 = InStr(n1 + 2, Cells(j, "B"), "+")

'if cells in Column "B" have "*+*+*+*" - put values between "+" in each rows and delete "+"

        If Cells(j, "B") Like "*+*+*+*" Then
                Cells(j, "B") = Right(Cells(j, "B"), n1 - 1)
                Cells(j - 1, "B") = Mid(Cells(j - 1, "B"), n2 + 1, n3 - n1 - 1)
                Cells(j - 2, "B") = Mid(Cells(j - 2, "B"), n1 + 1, n2 - n1 - 1)
                Cells(j - 3, "B") = Left(Cells(j - 3, "B"), n1 - 1)
        End If

'if cells in Column "B" have "*+*+*" - put values between "+" in each rows and delete "+"

        If Cells(j, "B") Like "*+*+*" Then
                Cells(j, "B") = Right(Cells(j, "B"), n1 - 1)
                Cells(j - 1, "B") = Mid(Cells(j - 1, "B"), n1 + 1, n2 - n1 - 1)
                Cells(j - 2, "B") = Left(Cells(j - 2, "B"), n1 - 1)
        End If

'if cells in Column "B" have "*+*" - put values between "+" in each rows and delete "+"

        If Cells(j, "B") Like "*+*" Then
                Cells(j, "B") = Right(Cells(j, "B"), n1 - 1)
                Cells(j - 1, "B") = Left(Cells(j - 1, "B"), n1 - 1)
        
        End If

    Next j