Excel VBA:分裂字符串

Question

所以我真的是VBA的新手，我遇到了一些问题。目标是在第一张纸上按下按钮，并在第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

如果您只有一个值向下列的值，则可以这样做。您需要在插入行时向后循环，并且可以使用拆分创建的数组，而不是必须循环遍历每个元素。

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

Answer 2

如果要将列A单元格分为列，则可以像以下内容一样进行：

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() sub

Answer 3

您水平说并在列上发短信，然后继续描述一行拆分。

行：

如果将输出堆叠在其他工作表中

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

或

在同一张纸中(尽管这只是在A列中存在并扩展(

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