拆分单元格中的一串文本，并使其与多列

Question

我想要分开一串文字。但是在分割字符串的同时，我需要它来提取与之关联的以下数据。我试过转置，我尝试过拆分功能。但它没有做我需要它做的事情。我可以尝试任何想法或建议。这是我想要完成的一个例子：

这是我目前所拥有和改变的，并试图从第一段代码修改。仍然无法弄明白：

Sub Test()
Dim rng As Range, Lstrw As Long, c As Range, d As Range
Dim SpltRng As Range
Dim i As Integer
Dim j As Integer
Dim Orig As Variant
Dim txt As String

Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:A" & Lstrw)

For Each c In rng.Cells
    Set SpltRng = c.Offset(, 1)
    txt = SpltRng.Value
    Orig = Split(txt, ",")

Lstrw = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B2:B" & Lstrw)

For Each d In rng.Cells
Set SpltRng = d.Offset(, 1) + 1


    For i = 0 To LBound(Orig)
        Cells(Rows.Count, "L").End(xlUp).Offset(1) = c
        Cells(Rows.Count, "L").End(xlUp).Offset(, 1) = Orig(i)

      For j = 0 To LBound(Orig)
        Cells(Rows.Count, "L").End(xlUp).Offset(1) = d
        Cells(Rows.Count, "L").End(xlUp).Offset(, 1) = Orig(j)
            Next j

         Next i

       Next d
   Next c

 End Sub

Answer 1

你过度思考它，你只需要在@Davesexcel提供的代码中添加一行：

Sub ChickatAH()
Dim rng As Range, Lstrw As Long, c As Range
Dim SpltRng As Range
Dim i As Integer
Dim Orig As Variant
Dim txt As String

Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:A" & Lstrw)

For Each c In rng.Cells
    Set SpltRng = c.Offset(, 1)
    txt = SpltRng.Value
    Orig = Split(txt, " ")

    For i = 0 To UBound(Orig)
        Cells(Rows.Count, "L").End(xlUp).Offset(1) = c
        Cells(Rows.Count, "L").End(xlUp).Offset(, 1) = Orig(i)
        'New Line
        Cells(Rows.Count, "L").End(xlUp).Offset(, 2).Resize(, 3).Value = c.Offset(, 2).Resize(, 3).Value
    Next i

Next c

End Sub