Excel macro -Split comma separated entries to new rows

后端 未结 5 703
说谎
说谎 2020-12-07 00:20

I currently have this data in a sheet

Col A   Col B   Col C
1       A       angry birds, gaming
2       B       nirvana,rock,band

What I wa

5条回答
  •  执笔经年
    2020-12-07 00:32

    This will do what you want.

    Option Explicit
    
    Const ANALYSIS_ROW As String = "C"
    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
    

提交回复
热议问题