通过分隔符将多列拆分为行

Question

我有两列有分隔符。两列将具有相同数量的分隔符。例如，A 列中的 a;b;c 和 B 列中的 d;e;f。在某些列中，可能没有任何合适的列。

我希望能够将这些列拆分为确切的行数，并从其他列复制数据。因此，上面的示例总共有 3 行，结果如下：

Col A   Col B
a         d
b         e
c         f

我找到了下面我修改并适用于指定列的代码，但如果可能，我想将其应用于多个列。

Option Explicit
Sub splitcells()

  Dim InxSplit As Long

  Dim SplitCell() As String

  Dim RowCrnt As Long

  With Worksheets("Sheet1")

    RowCrnt = 1

    Do While True


      If .Cells(RowCrnt, "L").Value = "" Then
        Exit Do
      End If

      SplitCell = Split(.Cells(RowCrnt, "L").Value, "*")

      If UBound(SplitCell) > 0 Then

        .Cells(RowCrnt, "L").Value = SplitCell(0)


        For InxSplit = 1 To UBound(SplitCell)
          RowCrnt = RowCrnt + 1

          .Rows(RowCrnt).EntireRow.Insert

          .Cells(RowCrnt, "L").Value = SplitCell(InxSplit)

          .Cells(RowCrnt, "A").Value = .Cells(RowCrnt - 1, "A").Value
          .Cells(RowCrnt, "B").Value = .Cells(RowCrnt - 1, "B").Value
          .Cells(RowCrnt, "C").Value = .Cells(RowCrnt - 1, "C").Value
          .Cells(RowCrnt, "D").Value = .Cells(RowCrnt - 1, "D").Value
          .Cells(RowCrnt, "E").Value = .Cells(RowCrnt - 1, "E").Value
          .Cells(RowCrnt, "F").Value = .Cells(RowCrnt - 1, "F").Value
          .Cells(RowCrnt, "G").Value = .Cells(RowCrnt - 1, "G").Value
          .Cells(RowCrnt, "H").Value = .Cells(RowCrnt - 1, "H").Value
          .Cells(RowCrnt, "I").Value = .Cells(RowCrnt - 1, "I").Value
          .Cells(RowCrnt, "J").Value = .Cells(RowCrnt - 1, "J").Value
          .Cells(RowCrnt, "K").Value = .Cells(RowCrnt - 1, "K").Value

        Next
      End If

      RowCrnt = RowCrnt + 1

    Loop

  End With

 End Sub

这可能吗？非常感谢任何帮助。

Answer 1

你好，花了我一段时间，但实际上我发现了一个非常有趣/有用的小程序，所以我玩了一下。

我创建了一个小程序，您可以在其中指定要从哪一列获取数据，以及要将数据粘贴到哪一列。使用以下调用：

parse_column 过程的编码方式如下：

' parses all the values into an array
Private Sub parse_column(columnID As Integer, toColumn As Integer)


    Dim totalstring As String
    Dim lastrow As Integer
    Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'change to whatever sheet you are working with
    Dim startingrow As Integer

    startingrow = 2 'change to whatever row you want the procedure to start from _
                    (i skipped first row, because it acts as a header)

    With ws
       lastrow = .Cells(.Rows.Count, columnID).End(xlUp).Row
    End With


    Dim columnrange As Range: Set columnrange = Range(Cells(startingrow, columnID), Cells(lastrow, columnID))
    For Each Rng In columnrange
        totalstring = totalstring + Trim(Rng) ' we'll concatenate all the column values into a one string _
                                                (if you wish to take spaces into accoumt, don't use trim)
    Next Rng

    Dim buffer() As String
    ReDim buffer(Len(totalstring) - 1) '(avoid indexation by 0)

    For i = 1 To Len(totalstring)
        buffer(i - 1) = Mid(totalstring, i, 1) 'we fill in buffer with values
    Next i


    ' we paste values to specified column
    For i = (LBound(buffer)) To UBound(buffer)
        ws.Cells((i + startingrow), toColumn).Value2 = buffer(i)
    Next i


End Sub

例如，如果您想解析从第 1 列 (A) 到第 4 列 (D) 的所有数据，您可以通过以下方式在您的过程中调用它

Private Sub splitcells()
    Call parse_column(1, 4)
End Sub

这一切的美妙之处在于，您可以通过一个简单的静态 for 循环增量来简单地将其循环到工作表中的所有列。例如，如果我们有 3 列：

假设我们有以下数据：

^ 请注意，C 列甚至不必限制为 3 个字符

我们可以使用一个简单的 for 循环遍历所有 3 列并将它们粘贴到右侧的第 4 列。

Private Sub splitcells()

    Dim i As Integer

    For i = 1 To 3
        Call parse_column(i, (i + 4))
    Next i

End Sub

会产生以下结果：