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

1

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

введите описание изображения здесь

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

Shruggie
источник
Насколько большой первый стол? Сколько всего возможных значений есть для каждого слота?
Адам
Взгляните на ветку здесь. Нужно немного подправить, но это хорошее место для начала.
gtwebb
"живое обновление"?
Raystafarian
Первая таблица будет около 50 строк и 10 столбцов. Только 2 столбца имеют запятые. Первый имеет максимум 14 элементов, второй максимум 5 элементов.
Shruggie
И «живое обновление», как при заполнении листа 1 этими данными, на листе 2 есть функции, которые разбивают данные листа 1 на расширенные строки, а не перезаписывают лист 1. Поскольку это форма, лист 1 будет продолжать получать новые строки
Shruggie

Ответы:

0

Я изменил скрипт по предоставленной ссылке 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
источник