VBA：將單元格值拆分爲多行並保留其他數據

Question

我在一列中有逗號分隔的值，我需要將它們拆分成新行並保持所有其他數據相同。我有可變數量的行。

我不知道有多少值會始終處於列B細胞，所以我需要循環陣列之上動態

實施例：

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循環來實現。唯一真正的技巧是每次插入新行時手動更新行計數器。那個被複制的「靜態」列高速緩存中的值，然後將它們寫入到插入的行只是一個簡單的問題：

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