How do I duplicate rows based on cell contents (ce

问题:

How do I duplicate rows based on the content of Column B. I'd like a separate row for each "Person" in the cell?

This is my starting table (I can't extract the data in any other way):

This is my goal:

Thanks for your help!

回答1:

You can implement a loop which will run through each of the rows below the header. While in each row, check the contents within Column B and perform the following function which will split the contents based on the character ";".

Split(Cells(row,"B"),";")

This will return an Array of values. For example [Person A, Person B, Person C] Now if this array has more than 1 value, then proceed to inserting a new row for each of the value in the Array after the 1st value.

Rows(row)EntireRow.Insert

Good luck!

回答2:

You haven't supplied any code so here's some starting concept:

Use a do until .cells(i,2).value = "" loop

Use newArray = Split(Cells(i,2).Value, ";") to get an array with each person name in it

Use a for x = lbound(newArray) to ubound(newArray) to cut the initial row and then insert x times and do a cells(i+x,2).value = newArray(x).value

finally don't forget to add the ubound(newarray) value to i otherwise you'll get stuck in an infinite loop of finding one person and adding a row.

回答3:

Assuming your data is in Sheet1 and desired output needs to be displayed in Sheet2, following code should help:

Sub SplitCell()
    Dim cArray As Variant
    Dim cValue As String
    Dim rowIndex As Integer, strIndex As Integer, destRow As Integer
    Dim targetColumn As Integer
    Dim lastRow As Long, lastCol As Long
    Dim srcSheet As Worksheet, destSheet As Worksheet

    targetColumn = 2 'column with semi-colon separated data

    Set srcSheet = ThisWorkbook.Worksheets("Sheet1") 'sheet with data
    Set destSheet = ThisWorkbook.Worksheets("Sheet2") 'sheet where result will be displayed

    destRow = 0
    With srcSheet
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For rowIndex = 1 To lastRow
            cValue = .Cells(rowIndex, targetColumn).Value 'getting the cell with semi-colon separated data
            cArray = Split(cValue, ";") 'splitting semi-colon separated data in an array
            For strIndex = 0 To UBound(cArray)
                destRow = destRow + 1
                destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
                destSheet.Cells(destRow, 2) = Trim(cArray(strIndex))
                destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)
            Next strIndex
        Next rowIndex
    End With
End Sub