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

#excel #vba

#excel #vba

Вопрос:

У меня в столбце A ряд разных значений. Нравится:

 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

Комментарии:

1. Пожалуйста, обновите заголовок вопроса и отредактируйте содержимое, которое не имеет четкого формата.

2. Используйте функцию Split(): techonthenet.com/excel/formulas/split.php

Ответ №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" amp; Rw).Value
    Do While nm <> ""
    StrS = Split(Ws.Range("E" amp; Rw).Value, ",")
    SubNameCnt = UBound(StrS)   1

        'Somehow speedy than single row insert
        If SubNameCnt > 0 Then
        Ws.Range("A" amp; Rw   1 amp; ":A" amp; Rw   SubNameCnt).EntireRow.Insert xlShiftDown
        Ws.Range("A" amp; Rw   1 amp; ":A" amp; Rw   SubNameCnt).Value = nm
        Ws.Range("C" amp; Rw   1 amp; ":C" amp; 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" amp; Rw).Offset(i   1).EntireRow.Insert xlShiftDown
        'Ws.Range("A" amp; Rw).Offset(i   1).Value = nm
        'Ws.Range("A" amp; Rw).Offset(i   1, 1).Value = i   1
        'Ws.Range("A" amp; Rw).Offset(i   1, 2).Value = StrS(i)
        'Next i

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

Код протестирован с использованием временных данных