如何根据单元格内容复制行（单元格包含分号分隔数据）

Question

如何根据B列的内容复制行。我希望每个＆＃34; Person＆＃34;在牢房？

这是我的起始表（我无法以任何其他方式提取数据）：

这是我的目标：

感谢您的帮助！

Answer 1

您可以实现一个循环，该循环将遍历标题下方的每一行。 在每一行中，检查B列中的内容并执行以下功能，该功能将根据字符＆＃34;;＆＃34;来分割内容。

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

这将返回一个值数组。例如[人A，人B，人C] 现在，如果此数组的值超过1，则继续为第一个值后的Array中的每个值插入一个新行。

Rows(row)EntireRow.Insert

祝你好运！

Answer 2

您还没有提供任何代码，所以这里有一些启动概念：

使用do until .cells(i,2).value = ""循环

使用newArray = Split(Cells(i,2).Value, ";")获取包含每个人名的数组

使用for x = lbound(newArray) to ubound(newArray)剪切初始行，然后插入x次并执行cells(i+x,2).value = newArray(x).value

最后不要忘记将ubound(newarray)值添加到i，否则您将陷入寻找一个人并添加一行的无限循环中。

Answer 3

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

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