Текст в столбец Макро сбой

Question

Я пытаюсь использовать этот макрос в качестве ярлыка для использования приглашения «Текст в столбец». Я выделяю столбец или группу рассматриваемых вертикальных ячеек, и при запуске макроса окно сообщения принимает разделитель из одного символа. Проблема возникает, когда все три из этих вещей происходят.

1. Это первый раз, когда я запускаю макрос в рабочей книге (Если я снова запускаю макрос, сбой не возникает)

2. Я выделяю весь столбец

3. Над первой ячейкой есть пустые ячейки, которые необходимо проанализировать.

Например, если у меня есть текст «123-456» в ячейке D10, я выделяю весь столбец D и запускаю макрос, ограничивающий «-», он разбирает данные на D1 и E1. Если я удаляю информацию в строке 1 и повторяю ее, она работает, кроме разбора данных в D10 и E10

Не уверен, как это устранить в противном случае.

Sub Txt2Clm()
'
' Txt2Clm Macro
'

'

    mbox = InputBox("Text-To-Columns", "Quick Step", "Enter Delimiter")

    Selection.TextToColumns , DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=mbox, FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True


End Sub

Ожидаемые результаты должны бытькак обычно работает Text to Column.

Answer 1

Дайте это попробовать. Он включает в себя множество проверок ошибок и проверки данных, чтобы убедиться, что он может только Text-To-Columns на действительные данные:

Sub Txt2Clm()

    Dim rValues As Range
    Dim rArea As Range
    Dim sDelim As String

    'Evalute selected range for valid data that can have text to columns performed on it (no blanks, no formulas)
    If Selection.Cells.Count = 1 Then
        If Selection.HasFormula = False And Len(Selection.Value) > 0 Then Set rValues = Selection
    Else
        'Only get constant values from first column (text to columns can only work on a single column at a time)
        On Error Resume Next
        Set rValues = Selection.Resize(, 1).SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
    End If

    If Not rValues Is Nothing Then
        'Prompt for delimiter
        sDelim = InputBox("Text-To-Columns", "Quick Step", "Enter Delimiter")
        If Len(sDelim) = 0 Then Exit Sub    'Pressed cancel
        If Len(sDelim) > 1 Then
            MsgBox "Delimiter must be a single character"
            Exit Sub
        End If

        Application.DisplayAlerts = False   'Prevent DisplayAlerts to suppress potential "Override existing data?" prompt
        For Each rArea In rValues.Areas
            rArea.TextToColumns rArea, xlDelimited, xlTextQualifierDoubleQuote, False, Other:=True, OtherChar:=sDelim
        Next rArea
        Application.DisplayAlerts = True
    Else
        MsgBox "No cells containing valid data selected."
    End If

End Sub

Answer 2

Хорошо, при вырезании большого количества ложных и т. Д. У меня есть этот код, который работает, не привязываясь к вашему массиву fieldinfo:

Sub ttc()
    mbox = InputBox("Text-To-Columns", "Quick Step", "Enter Delimiter")
    Selection.TextToColumns , DataType:=xlDelimited, Other:=True, OtherChar:=mbox
End Sub

---

Проверено нанекоторые быстрые данные ... до:

и после:

---

Edit1:

Собираюсь взглянуть на то, как избежать использования Selection в TTC, как и в других постах, на которые я ссылался в комментариях ...

Сделайте снимок, чтобы увидеть, решит ли указание начальная / конечная строка эту проблему:

Sub TTC()
    mbox = InputBox("Text-To-Columns", "Quick Step", "Enter Delimiter")
    Dim sr As Long, er As Long, c As Long
    sr = Selection.Row 'start row
    er = Selection.Rows.Count + sr - 1 'end row
    c = Selection.Column 'column
    Range(Cells(sr, c), Cells(er, c)).TextToColumns , DataType:=xlDelimited, Other:=True, OtherChar:=mbox
End Sub