VBA：将单元格值拆分为多行并保留其他数据

我在一列中的值用逗号分隔，我需要将它们拆分成新的行，并保持所有其他数据相同。 我有可变数量的行。

我不知道有多less值总是会在列B的单元格中，所以我需要dynamic地循环访问数组

例：

ColA ColB ColC ColD Monday A,B,C Red Email 

输出：

 ColA ColB ColC ColD Monday A Red Email Monday B Red Email Monday C Red Email 

尝试过这样的事情：

 colArray = Split(ws.Cells(i, 2).Value, ", ") For i = LBound(colArray) To UBound(colArray) Rows.Insert(i) Next i 

但是我不确定如何将数据保留在第一列，并将数据复制到其他列。

Answer 1

试试这个，你可以很容易地将它调整到你的实际工作表名称和列进行拆分。

 Sub splitByColB() Dim r As Range, i As Long, ar Set r = Worksheets("Sheet1").Range("B999999").End(xlUp) Do While r.row > 1 ar = Split(r.value, ",") If UBound(ar) >= 0 Then r.value = ar(0) For i = UBound(ar) To 1 Step -1 r.EntireRow.Copy r.Offset(1).EntireRow.Insert r.Offset(1).value = ar(i) Next Set r = r.Offset(-1) Loop End Sub 

Answer 2

你也可以通过使用Do循环来代替For循环。 唯一真正的技巧是每次插入新行时手动更新行计数器。 被复制的“静态”列只是caching值并将其写入插入行的一个简单问题：

 Dim workingRow As Long workingRow = 2 With ActiveSheet Do While Not IsEmpty(.Cells(workingRow, 2).Value) Dim values() As String values = Split(.Cells(workingRow, 2).Value, ",") If UBound(values) > 0 Then Dim colA As Variant, colC As Variant, colD As Variant colA = .Cells(workingRow, 1).Value colC = .Cells(workingRow, 3).Value colD = .Cells(workingRow, 4).Value For i = LBound(values) To UBound(values) If i > 0 Then .Rows(workingRow).Insert xlDown End If .Cells(workingRow, 1).Value = colA .Cells(workingRow, 2).Value = values(i) .Cells(workingRow, 3).Value = colC .Cells(workingRow, 4).Value = colD workingRow = workingRow + 1 Next Else workingRow = workingRow + 1 End If Loop End With 

Answer 3

这将做你想要的。

 Option Explicit Const ANALYSIS_ROW As String = "B" Const DATA_START_ROW As Long = 1 Sub ReplicateData() Dim iRow As Long Dim lastrow As Long Dim ws As Worksheet Dim iSplit() As String Dim iIndex As Long Dim iSize As Long 'Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With ThisWorkbook .Worksheets("Sheet4").Copy After:=.Worksheets("Sheet4") Set ws = ActiveSheet End With With ws lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row End With For iRow = lastrow To DATA_START_ROW Step -1 iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",") iSize = UBound(iSplit) - LBound(iSplit) + 1 If iSize = 1 Then GoTo Continue ws.Rows(iRow).Copy ws.Rows(iRow).Resize(iSize - 1).Insert For iIndex = LBound(iSplit) To UBound(iSplit) ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex) Next iIndex Continue: Next iRow Application.CutCopyMode = False Application.Calculation = xlCalculationAutomatic 'Application.ScreenUpdating = True End Sub