如何根据单元格内容复制行(单元格包含分号分隔的数据) [英] How do I duplicate rows based on cell contents (cell contains semi-colon seperated data)

问题描述

如何根据列B的内容复制行.我想为单元格中的每个人员"单独保留一行?

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):

这是我的目标:

感谢您的帮助！

推荐答案

假设您的数据位于 Sheet1 中，并且所需的输出需要显示在 Sheet2 中，以下代码应帮助:

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

这篇关于如何根据单元格内容复制行(单元格包含分号分隔的数据)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！