在单元格中拆分一串文本，并将其与多个列相关联

我有一串我想分裂的文字。 但在string被拆分的同时，我需要它来拉取与之相关的以下数据。 我试过转座，我已经尝试了拆分function。 但是这并没有做到我所需要的。 任何想法或build议，我可以尝试。 这是我想要实现的一个例子：

这是我目前已经改变，并试图从第一段代码修改。 仍然无法弄清楚：

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