Подпрограмма Excel, транспонировать значения, разделенные запятой в строках

Question

У меня проблема, на работе меня попросили взять набор данных и внести некоторые изменения.Проблема в том, что есть одно поле, содержащее значения 1,2,3,4-10,13-17,20, и мне нужно расширить несколько диапазонов в ячейке, транспонировать рисунки в строки и скопировать оставшуюся часть строки вместе с ним.

Пример:

FIELD1 FIEL2 FIELD3 FIELD4
test1  test2 test3  1,2,3,4-10

должно стать:

FIELD1 FIEL2 FIELD3 FIELD4
test1  test2 test3  1
test1  test2 test3  2
test1  test2 test3  3
test1  test2 test3  4
test1  test2 test3  5
test1  test2 test3  6

и повторять то же самое для всех оставшихся строк, пока не будет найдена пустая ячейка.

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

Select the first cell and run the routine from a button
1,2,3
4,5,6

Любая помощь?Заранее спасибо.

Sub Ops()

    'DECLARE VARIABLES
    Dim i As Long, st As String
    i = 1
    Dim startP As Range
    Dim c As Collection
    Dim count As Integer
    Set c = New Collection
    ary = Split(ActiveCell.Value, ",")

    Do Until IsEmpty(ActiveCell.Value)
        count = 0

        For Each r In Selection
            If i = 1 Then
                st = r.Text
                i = 1
            Else
                st = st & "," & r.Text
            End If
        Next r

        Set startP = Selection(1, 2)
        ary = Split(st, ",")
        i = 1

        For Each a In ary
            count = count + 1
            startP(i, 1).Value = a
            i = i + 1
        Next a

        'COUNT MINUS 1
        scount = count - 1

        'REPEAT UNTIL REACH COUNT
        For ba = 1 To scount
            'COPY AND INSERT ROWS BELOW
            ActiveCell.Copy
            Selection.Insert Shift:=xlDown
        Next ba

        Selection.Offset(count, 1).Select

        'ONCE THE LOOP IS FINISH GO TO NEXT CELL
        Selection.Offset(0, -1).Select

    Loop

End Sub

Вы можете увидеть данные ниже

В ячейке Почтовый индекс мне нужно развернутьнесколько диапазонов, а также скопируйте и вставьте ниже одной строки X × количество почтовых индексов в ячейке.

Answer 1

Этот код делает то, что вам нужно - учтите, что у меня нет четко определенных ссылок на ячейки, поскольку мы основываемся на ActiveCell, я оставил диапазоны как Range, а не worksheet.Range

Sub x()
Do While ActiveCell.Value2 <> ""
    If InStr(1, ActiveCell.Value2, ",") > 0 Or InStr(1, ActiveCell.Value2, "-") > 0 Then e
    ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub e()

Dim a As Long
Dim r As Long
Dim c As Long
Dim rc As Long
Dim i As Long
Dim j As Long
Dim x() As String
Dim t() As String

    x = Split(ActiveCell, ",")
    r = ActiveCell.Row
    c = ActiveCell.Column


    For i = LBound(x) To UBound(x)
        If InStr(1, x(i), "-") Then
            a = a + Split(x(i), "-")(1) - Split(x(i), "-")(0)
        End If
    Next i

    a = a + UBound(x)
    Range(Cells(r + 1, c), Cells(r + a, c)).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    For i = LBound(x) To UBound(x)
        t = Split(x(i), "-")
        If UBound(t) = 0 Then
            Cells(r + rc, c).Value2 = t(0)
            rc = rc + 1
        Else
            For j = t(0) To t(1)
                Cells(r + rc, c).Value2 = j
                rc = rc + 1
            Next j
        End If
    Next i

    Range(Cells(r, c - 3), Cells(r + rc - 1, c - 1)).Value2 = _
        Range(Cells(r, c - 3), Cells(r, c - 1)).Value2

End Sub

Это в основном заполняет этот столбец один за другим на основе чисел x,y,a-b,z, разделяя сначала на ,, а затем на любые экземпляры -

После этого у него уже есть счетчик строкrc так что просто используйте этот счетчик для заполнения диапазона сверху вниз, дублируя значения в 3 столбцах перед активной ячейкой

РЕДАКТИРОВАТЬ: я добавил 5 строк, которые фактически проходят через диапазоны (1,2,4-7 как угодно), чтобы подсчитать, сколько строк до INSERT до фактического заполнения информации.

EDIT2: я добавил еще одну подпрограмму под названием x, чтобы сделать этот цикл e, пока он не достигнет ячейкив нем ничего нет ... Итак, чтобы исправить весь лист, просто выделите самую верхнюю ячейку с диапазоном, например (1,3,4-7 ... и т. д.), и запустите процедуру x