时间戳

首页 > 解决方案 > 文本到列宏故障

excel - 文本到列宏故障

问题描述

我正在尝试将此宏用作使用“文本到列”提示的快捷方式。我突出显示有问题的列或垂直单元格组，并且在运行宏时，消息框接受一个字符分隔符。当这三件事都发生时，就会出现问题。

  1. 这是我第一次在工作簿中运行宏（如果我再次运行宏，则不会发生故障）

  2. 我突出显示一整列

  3. 需要解析的第一个单元格上方有空白单元格。

例如，如果我在单元格 D10 中有文本“123-456”，我突出显示所有 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 通常的工作方式。

标签： excelvba

解决方案

试试这个。它包括许多错误检查和数据验证，以确保它只能对有效数据进行 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

推荐阅读