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

Я хочу перейти от чего-то вроде первой таблицы ко второй таблице:

... ради использования в сводной таблице. Я хотел бы, чтобы первая таблица была на одном листе, а вторая таблица - на другом листе, обновляя в реальном времени эту «разобранную» вторую таблицу. Я пытался некоторое время и не могу заставить это работать. Какие-либо предложения? Форма, которую я использую, выводит этот тип списка в виде разделенных запятыми значений в отдельных ячейках, и в этом случае это нецелесообразно делать вручную, так как будет тысячи строк.

microsoft-excel microsoft-excel-2010

— Shruggie
источник

Насколько большой первый стол? Сколько всего возможных значений есть для каждого слота?

— Адам

Взгляните на ветку здесь. Нужно немного подправить, но это хорошее место для начала.

— gtwebb

"живое обновление"?

— Raystafarian

Первая таблица будет около 50 строк и 10 столбцов. Только 2 столбца имеют запятые. Первый имеет максимум 14 элементов, второй максимум 5 элементов.

— Shruggie

И «живое обновление», как при заполнении листа 1 этими данными, на листе 2 есть функции, которые разбивают данные листа 1 на расширенные строки, а не перезаписывают лист 1. Поскольку это форма, лист 1 будет продолжать получать новые строки

— Shruggie

Я изменил скрипт по предоставленной ссылке gtwebb . Вот сценарий:

Option Explicit

Sub Main()

Columns("B:B").NumberFormat = "@"
Dim i As Long, c As Long, r As Range, v As Variant

For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
    v = Split(Range("B" & i), ", ")
    c = c + UBound(v) + 1
Next i

For i = 2 To c
    Set r = Range("B" & i)
    Dim arr As Variant
    arr = Split(r, ", ")
    Dim j As Long
    r = arr(0)
    For j = 1 To UBound(arr)
        Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
        r.Offset(j, 0) = arr(j)
        r.Offset(j, -1) = r.Offset(0, -1)
        r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i

Columns("C:C").NumberFormat = "@"
Dim k As Long, d As Long, s As Range, w As Variant

For k = 1 To Range("C" & Rows.Count).End(xlUp).Row
    w = Split(Range("C" & k), ", ")
    d = d + UBound(w) + 1
Next k

For k = 2 To d
    Set s = Range("C" & k)
    Dim arrb As Variant
    arrb = Split(s, ", ")
    Dim m As Long
    s = arrb(0)
    For m = 1 To UBound(arrb)
        Rows(s.Row + m & ":" & s.Row + m).Insert Shift:=xlDown
        s.Offset(m, 0) = arrb(m)
        s.Offset(m, -1) = s.Offset(0, -1)
        s.Offset(m, -2) = s.Offset(0, -2)
    Next m
Next k
End Sub

Так как мне нужно было это только для двух столбцов, я не стал зацикливаться. Изменено только то, что скрипт повторяется второй раз, переменные меняются, а Offsetпараметр изменяется.

— Shruggie
источник