Excel VBA: разделение строк

Question

Так что я действительно новичок в VBA, и у меня возникла пара проблем.Цель состоит в том, чтобы нажать кнопку в то время как на листе 1, и чтобы текст в столбцы появлялся на листе 2.

Пока у меня есть этот код (прилагается ниже).Мои главные проблемы заключаются в том, что я не могу заставить его разделиться по горизонтали, я также не могу вставить в него кнопку.

Любая помощь будет очень признательна!

Спасибо

Что у меня сейчас есть:

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, "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 splitcells()
    Dim rng As Range, counter As Long, nextRow As Long
    counter = 1
    For Each rng In Intersect(Worksheets("sheet1").Columns("A"), Worksheets("Sheet1").UsedRange)

        If counter = 1 Then
            Worksheets("Sheet2").Range(rng.Address).Resize(UBound(Split(Trim(rng), "/")) + 1, 1) = Application.Transpose(Split(rng, "/"))
            nextRow = UBound(Split(Trim(rng), "/"))

        Else
            Worksheets("Sheet2").Range(rng.Address).Offset(nextRow).Resize(UBound(Split(Trim(rng), "/")) + 1, 1) = Application.Transpose(Split(rng, "/"))
            nextRow = nextRow + UBound(Split(rng, "/"))
        End If

      counter = counter + 1
    Next rng
End Sub

Или

На том же листе (хотя это просто перезаписывает существующий в столбце А и расширяет)

Option Explicit
Public Sub splitcells()
    Dim rng As Range, outputString As String
    With Worksheets("Sheet1")
       If Application.WorksheetFunction.CountIf(Intersect(.Columns("A"), .UsedRange), "*/*") = 0 Then Exit Sub
        For Each rng In Intersect(.Columns("A"), .UsedRange)
            If Not IsEmpty(rng) Then
                outputString = outputString & "/" & rng.Value
            End If
        Next rng
        outputString = Right$(outputString, Len(outputString) - 1)
        .Range("A1").Resize(UBound(Split(outputString, "/")) + 1, 1).Value = Application.Transpose(Split(outputString, "/"))
    End With
End Sub

Если бы это был текст в столбцы на другом листе, вы могли бы перейти:

Option Explicit
Sub splitcells()
    Application.ScreenUpdating = False
    Dim rng As Range

    For Each rng In Intersect(Worksheets("sheet1").Columns("A"), Worksheets("Sheet1").UsedRange)
       On Error Resume Next
        Worksheets("Sheet2").Range(rng.Address).Resize(1, UBound(Split(rng, "/")) + 1) = Split(rng, "/")
        On Error GoTo 0
    Next rng
    Application.ScreenUpdating = True
End Sub

Answer 2

Если вы хотите разбить содержимое ячеек столбца А на столбцы, вы можете просто выполнить следующие действия:

Sub SplitCells()
    With Worksheets("Sheet2") ' change "Sheet2" to the actual sheet name where this has to happen
        .Range("A1", .Cells(.Rows.count, 1).End(xlUp)).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="/"
    End With
End Sub

, и если вы хотите, чтобы это произошло после нажатия кнопки на любом листе, просто прикрепите эту кнопку кэто SplitCells() суб

Answer 3

Если у вас есть значения, идущие вниз по столбцу А, вы можете сделать это следующим образом.При вставке строк вам нужно выполнять цикл в обратном направлении, и вы можете использовать массив, созданный с помощью split, вместо того, чтобы проходить через каждый элемент.

Sub x()

Dim r As Long, v

For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    v = Split(Cells(r, 1), "/")
    If UBound(v) > 0 Then
        Cells(r, 1).Resize(UBound(v)).Insert shift:=xlDown
        Cells(r, 1).Resize(UBound(v) + 1).Value = Application.Transpose(v)
    End If
Next r

End Sub