將Excel中的多值單元格拆分成行

Question

我在Excel中遇到了一個問題，我打算通過VBA將多值單元格拆分爲多行。

這是我目前的表

然後我試圖使它像這樣

謝謝

Answer 1

這將做你想做的。我假設你的'電子郵件'列是B列，你從第1行開始。

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("Sheet1").Copy After:=.Worksheets("Sheet1") 
     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