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

会产生以下结果：

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

1 个答案: