Создание нескольких строк из ячейки

Question

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

Sub SplitCellValue()
    Dim str As String
    Dim ArrStr() As String

    'Fill variables: str is the value of the active cell, ArrStr splits this value at the comma
    str = ActiveCell.Value
    ArrStr = Split(str, ", ")

    'Loop through each ArrStr to populate each cell below the activecell

    For i = 0 To UBound(ArrStr)
        ActiveCell.Offset(i, 0).Value = ArrStr(i)
    Next i
    End Sub

Answer 1

Попробуйте этот код, пожалуйста. Вам также нужно вставить строку в каждую итерацию. Опуская элемент массива 0, вы пропускаете первый:

Sub SplitCellValue()
    Dim str As String, actCell As Range, i As Long
    Dim ArrStr() As String
     Set actCell = ActiveCell 'it must be the cell with the comma separated string

     str = actCell.value
     ArrStr = Split(str, ", ")

    For i = UBound(ArrStr) To 1 Step -1
        actCell.Offset(1, 0).EntireRow.Insert
        actCell.Offset(1, 0).value = ArrStr(i)
    Next i
End Sub

Вариант после вашего последнего «объяснения» ...

Sub SplitCellValue()
    Dim str As String, actCell As Range, i As Long
    Dim ArrStr() As String
     Set actCell = ActiveCell 'it must be the cell with the comma separated string

     str = actCell.value
     ArrStr = Split(str, ", ")
     If UBound(ArrStr) = 0 Then MsgBox _
       "Please select the cell keeping the comma separated string": Exit Sub
    actCell.value = ArrStr(0)
    For i = 1 To UBound(ArrStr)
        actCell.Offset(i, 0).value = ArrStr(i)
    Next i
End Sub

Ваш код не работал, потому что он обновлялся каждый раз, когда ActiveCell. Должен быть установлен с самого начала ...

Answer 2

Добавьте дополнительно For...Next l oop в существующий, чтобы добавить строки. Включите и If оператор с логическим значением, чтобы определить, добавлены ли строки или нет (и, следовательно, если они должны быть или нет).

Это будет только вставить новую строку для столбца активной ячейки .

Что-то вроде:

'Loop through each ArrStr to populate each cell below the activecell
Dim i As Long
Dim y As Long
Dim RowsAdded As Boolean

RowsAdded = False

For i = 0 To UBound(ArrStr)
    ActiveCell.Offset(i, 0).Value = ArrStr(i)
    If RowsAdded = False Then
        For y = 1 To UBound(ArrStr)
            ActiveCell.Offset(1, 0).EntireRow.Insert xlDown
        Next y
        RowsAdded = True
    End If
Next i

Вот изображения до и после выполнения кода:

До:

После: