VBA для преобразования текста в столбцы на нескольких листах, кроме одного

Question

Я новичок в кодировании VBA и пытаюсь преобразовать текст на всех листах, кроме одного, в текст, но не достиг успеха. У меня есть текст в столбце A каждого листа, и количество строк может отличаться.

Вот так выглядит мой код

Sub text_to_column()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim arr() As Variant, i As Long, nrCol As Long

    For Each ws In ThisWorkbook.Worksheets
     If ws.Name <> "Summary" Then
            ws.Select
            nrCol = 20
            ReDim arr(1 To nrCol) As Variant
            For i = 1 To nrCol
            arr(i) = Array(i, 1)
            Next
            Selection.TextToColumns _
            Destination:=Range("A1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=True, _
            Semicolon:=False, _
            Comma:=False, _
            Space:=False, _
            Other:=True, _
            OtherChar:="^", _
            FieldInfo:=arr, _
            TrailingMinusNumbers:=True
    End If
    Next ws

    End Sub

Пожалуйста, руководство.

Answer 1

Попробуйте этот код

Sub Test()
Dim a, x, ws As Worksheet, r As Long

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Summary" Then
        For r = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
            x = Split(ws.Cells(r, 1).Value, "^")
            ws.Cells(r, 2).Resize(, UBound(x) + 1).Value = x
        Next r
    End If
Next was
End Sub

А что касается вашего подхода, вы можете использовать такой код

Sub TextToColumns()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Summary" Then
        Application.DisplayAlerts = False
            ws.Columns(1).TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="^", FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True
        Application.DisplayAlerts = True
    End If
Next was
End Sub