将字符串文本拆分为单独的行并将剩余的列复制下来

Question

我有A列和B列，其中有多个数据条目，由＆＃34;;＆＃34;分隔。

C到Y列也包含数据，但有些列可能是空白的。

我正在尝试使用＆＃34 ;;＆＃34;来分隔Col A中每个单元格中的数据，为每个单独的项目插入一个新行，并将关联的数据从col B复制到Y.然后执行对于Col B来说，将数据从Col A和Col C复制到Y。

我找到了代码，但仅限于复制Col B.

Option Explicit

Sub splitcellsmodified()

  Dim InxSplit As Long
  Dim SplitCell() As String
  Dim RowCrnt As Long

  With Worksheets("Sheet1")

    RowCrnt = 1

    Do While True
      If .Cells(RowCrnt, "A").Value = "" Then
        Exit Do
      End If
      SplitCell = Split(.Cells(RowCrnt, "A").Value, ";")

      If UBound(SplitCell) > 0 Then
        .Cells(RowCrnt, "A").Value = SplitCell(0)
        For InxSplit = 1 To UBound(SplitCell)
          RowCrnt = RowCrnt + 1
          .Rows(RowCrnt).EntireRow.Insert
          .Cells(RowCrnt, "A").Value = SplitCell(InxSplit)
          .Cells(RowCrnt, "B").Value = .Cells(RowCrnt - 1, "B").Value
        Next
      End If

      RowCrnt = RowCrnt + 1

    Loop

  End With

End Sub

起点

预期结果

Answer 1

（请注意：此答案会写入新工作表，而不是分割输入屏幕中的行）

尽可能接近您的代码，我会得到：

Option Explicit

Sub splitCellsModified()

  Dim InxSplitA As Long
  Dim InxSplitB As Long         'We want to split 2 cells rather than 1
  Dim SplitCellA() As String
  Dim SplitCellB() As String    'We want to split 2 cells rather than 1
  Dim RowCrnt As Long
  Dim RowOutput As Long
  Dim wsOutput As Worksheet

  With Worksheets("Sheet1")

    Worksheets.Add              ' The new worksheet becomes the active sheet.
    Set wsOutput = ActiveSheet
    wsOutput.Name = "AfterSplitup"
    RowCrnt = 1
    RowOutput = 1

    Do While True
      If .Cells(RowCrnt, "A").Value = "" Then
        Exit Do
      End If
      SplitCellA = Split(.Cells(RowCrnt, "A").Value, ";")
      SplitCellB = Split(.Cells(RowCrnt, "B").Value, ";")

      For InxSplitB = LBound(SplitCellB) To UBound(SplitCellB)
        For InxSplitA = LBound(SplitCellA) To UBound(SplitCellA)
          wsOutput.Cells(RowOutput, "A").Value = SplitCellA(InxSplitA)
          wsOutput.Cells(RowOutput, "B").Value = SplitCellB(InxSplitB)
          .Rows(RowCrnt).Range("C1:Y1").Copy _
              Destination:=wsOutput.Rows(RowOutput).Range("C1:Y1")
          RowOutput = RowOutput + 1
        Next InxSplitA
      Next InxSplitB

      RowCrnt = RowCrnt + 1

    Loop

  End With

End Sub