Как решить отладку этого вопроса проще в vba

Question

У меня в столбце А есть ряд различных значений.Как:

CA_ALAMEDA
CA_ALPINE
OR_LANE

и так далее.Около 300 строк.

Для каждой строки в столбце E у меня есть от одного до 85 значений, разделенных запятыми, например:

SAN LEANDRO,HAYWARD,ALBANY,ALAMEDA
BEAR VALLEY,LAKE ALPINE,KIRKWOOD,MESA VISTA,MARKLEEVILLE,WOODFORDS,FREDRICKSBURG,CRYSTAL SPRINGS
EUGENE,SPRINGFIELD

Что мне нужно сделать смакрос

1. Вставьте число строк между каждой существующей строкой, равное количеству запятых в ячейке в столбце E. Я уже определяю количество запятых и помещаю этозначение в столбце B. (Итак, первая строка показывает: CA_ALAMEDA. . . 3. . . <column c=""> . . . <column d=""> . . . SAN LEANDRO,HAYWARD,ALBANY,ALAMEDA

2. Заполните ячейки в новых строках отдельными значениями из столбца E. Я бы поместил их в столбец CТаким образом, конечный результат будет выглядеть так: CA_ALAMEDA . . . 3 . . . SAN LEANDRO . . . <column d=""> . . . SAN LEANDRO,HAYWARD,ALBANY,ALAMEDA . . . . . . . . . . . . . . . . . . HAYWARD . . . . . . . . . . . . . . . . . . ALBANY . . . . . . . . . . . . . . . . . . ALAMEDA CA_ALPINE. . . . . .7 . . . BEAR VALLEY . . . . <column d=""> . . . BEAR VALLEY,LAKE ALPINE,KIRKWOOD,MESA VISTA,MARKLEEVILLE,WOODFORDS,FREDRICKSBURG,CRYSTAL SPRINGS . . . . . . . . . . . . . . . . . . LAKE ALPINE . . . . . . . . . . . . . . . . . . KIRKWOOD

Answer 1

Может попробовать что-то вроде (если я правильно понял вопрос)

Sub test()
Dim Ws As Worksheet, StrS As Variant, SubNameCnt As Long
Dim Rw As Long
Set Ws = ThisWorkbook.Sheets("Sheet2")
Rw = 1
nm = Ws.Range("A" & Rw).Value
    Do While nm <> ""
    StrS = Split(Ws.Range("E" & Rw).Value, ",")
    SubNameCnt = UBound(StrS) + 1

        'Somehow speedy than single row insert
        If SubNameCnt > 0 Then
        Ws.Range("A" & Rw + 1 & ":A" & Rw + SubNameCnt).EntireRow.Insert xlShiftDown
        Ws.Range("A" & Rw + 1 & ":A" & Rw + SubNameCnt).Value = nm
        Ws.Range("C" & Rw + 1 & ":C" & Rw + SubNameCnt).Value = Application.Transpose(StrS)
        End If

        'A slow process (so not used but produced for simple understanding only)
        'For i = LBound(StrS) To UBound(StrS)
        'Ws.Range("A" & Rw).Offset(i + 1).EntireRow.Insert xlShiftDown
        'Ws.Range("A" & Rw).Offset(i + 1).Value = nm
        'Ws.Range("A" & Rw).Offset(i + 1, 1).Value = i + 1
        'Ws.Range("A" & Rw).Offset(i + 1, 2).Value = StrS(i)
        'Next i

    Rw = Rw + SubNameCnt + 1
    nm = Ws.Range("A" & Rw).Value
    Loop
End Sub

Код проверен с временными данными