Разделить несколько столбцов на строки разделителем

Question

У меня есть два столбца, которые имеют разделители.Оба столбца будут иметь одинаковое количество разделителей.например, a;b;c в столбце A и d;e;f в столбце B. В некоторых столбцах не может быть ни одного, который подходит.

Я хочу иметь возможность разбить эти столбцы на точное количество строк и скопировать данныеиз других столбцов.Таким образом, приведенный выше пример будет иметь в общей сложности 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

даст следующий результат: