VBA宏报错Run-time error 1004：Range类TextToColumns方法执行失败求助

问题描述 #

开发VBA宏时，执行TextToColumns方法时触发错误：Run-time error '1004': TextToColumns method of Range class failed，相关代码如下：

tbl = req_get(url1, ck, authenticate)
    c.SetText tbl
    c.PutInClipboard

With ws
 If r = .Cells(1048576, 1).End(xlUp).Row = 0 Then
        r = .Cells(1048576, 1).End(xlUp).Row
        Else:
        r = .Cells(1048576, 1).End(xlUp).Row + 1
        End If
        .Activate
        .Cells(r, 1).Select
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayasIcon:=False, noHTMLFormatting:=True
        If .Cells(1, 2) = "" Then .Columns(1).TextToColumns DataType:=xlDelimited, consecutivedelimiter:=False, Comma:=True

Sheets("Rooster").Range("P1") = "Shift Patty"
Sheets("Rooster").Range("Q1") = "Shift"
endrow = Sheets("Rooster").Cells(1048576, 20).End(xlUp).Row + 1
For g = endrow To Sheets("Rooster").Cells(1048576, 1).End(xlUp).Row
Sheets("Rooster").Range("P" & g) = Left(Sheets("Rooster").Range("M" & g), 2)
If Sheets("Rooster").Range("P" & g) = "DB" Then
Sheets("Rooster").Range("Q" & g) = "BHD"
End If
If Sheets("Rooster").Range("P" & g) = "NA" Then
Sheets("Rooster").Range("Q" & g) = "FHN"
End If
If Sheets("Rooster").Range("P" & g) = "DC" Then
Sheets("Rooster").Range("Q" & g) = "Donut"
End If
If Sheets("Rooster").Range("P" & g) = "DA" Then
Sheets("Rooster").Range("Q" & g) = "FHD"
End If
If Sheets("Rooster").Range("P" & g) = "X1" Then
Sheets("Rooster").Range("Q" & g) = "FLEX"
End If
If Sheets("Rooster").Range("P" & g) = "AC" Then
Sheets("Rooster").Range("Q" & g) = "FLEX"
End If
If Sheets("Rooster").Range("P" & g) = "RT" Then
Sheets("Rooster").Range("Q" & g) = "BHN"
End If
If Sheets("Rooster").Range("P" & g) = "PT" Then
Sheets("Rooster").Range("Q" & g) = "PT"
End If

Next g


End With

End Sub

报错原因分析 #

• 拆分范围不合理：直接对整列执行TextToColumns，若第一列数据量过大或无有效分隔符，会触发资源不足或格式错误。
• 判断逻辑有问题：If .Cells(1, 2) = ""仅检查第一行第二列，若后续行第二列有数据仍会执行拆分，导致列数据冲突。
• 行号计算错误：If r = .Cells(1048576, 1).End(xlUp).Row = 0的判断语法错误，无法正确获取起始行号。
• 未验证粘贴数据：粘贴后未检查第一列是否有有效内容就执行拆分，空数据或无效格式会触发报错。

解决方案 #

1. 修复行号计算逻辑 #

Dim lastRowCol1 As Long
lastRowCol1 = .Cells(.Rows.Count, 1).End(xlUp).Row
If lastRowCol1 = 0 Then
    r = 1
Else
    r = lastRowCol1 + 1
End If

2. 避免激活和选择操作，直接粘贴 #

.Cells(r, 1).PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True

3. 限定拆分范围并优化判断条件 #

仅对粘贴后的有效数据区域执行拆分，同时验证数据有效性：

lastRowCol1 = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(1, 2) = "" And lastRowCol1 >= r And .Cells(r, 1).Value <> "" Then
    .Range(.Cells(r, 1), .Cells(lastRowCol1, 1)).TextToColumns DataType:=xlDelimited, _
        ConsecutiveDelimiter:=False, Comma:=True
End If

4. 优化多条件判断（提升代码效率） #

将多个If改为Select Case：

For g = endrow To Sheets("Rooster").Cells(1048576, 1).End(xlUp).Row
    Sheets("Rooster").Range("P" & g) = Left(Sheets("Rooster").Range("M" & g), 2)
    Select Case Sheets("Rooster").Range("P" & g).Value
        Case "DB": Sheets("Rooster").Range("Q" & g) = "BHD"
        Case "NA": Sheets("Rooster").Range("Q" & g) = "FHN"
        Case "DC": Sheets("Rooster").Range("Q" & g) = "Donut"
        Case "DA": Sheets("Rooster").Range("Q" & g) = "FHD"
        Case "X1", "AC": Sheets("Rooster").Range("Q" & g) = "FLEX"
        Case "RT": Sheets("Rooster").Range("Q" & g) = "BHN"
        Case "PT": Sheets("Rooster").Range("Q" & g) = "PT"
    End Select
Next g

完整修改后关键代码片段 #

tbl = req_get(url1, ck, authenticate)
c.SetText tbl
c.PutInClipboard

With ws
    Dim lastRowCol1 As Long
    lastRowCol1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    ' 修复行号计算
    If lastRowCol1 = 0 Then
        r = 1
    Else
        r = lastRowCol1 + 1
    End If
    
    ' 直接粘贴
    .Cells(r, 1).PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    
    ' 获取粘贴后的数据行范围，执行拆分
    lastRowCol1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    If .Cells(1, 2) = "" And lastRowCol1 >= r And .Cells(r, 1).Value <> "" Then
        .Range(.Cells(r, 1), .Cells(lastRowCol1, 1)).TextToColumns DataType:=xlDelimited, _
            ConsecutiveDelimiter:=False, Comma:=True
    End If
    
    ' Rooster工作表操作
    Sheets("Rooster").Range("P1") = "Shift Patty"
    Sheets("Rooster").Range("Q1") = "Shift"
    endrow = Sheets("Rooster").Cells(1048576, 20).End(xlUp).Row + 1
    For g = endrow To Sheets("Rooster").Cells(1048576, 1).End(xlUp).Row
        Sheets("Rooster").Range("P" & g) = Left(Sheets("Rooster").Range("M" & g), 2)
        Select Case Sheets("Rooster").Range("P" & g).Value
            Case "DB": Sheets("Rooster").Range("Q" & g) = "BHD"
            Case "NA": Sheets("Rooster").Range("Q" & g) = "FHN"
            Case "DC": Sheets("Rooster").Range("Q" & g) = "Donut"
            Case "DA": Sheets("Rooster").Range("Q" & g) = "FHD"
            Case "X1", "AC": Sheets("Rooster").Range("Q" & g) = "FLEX"
            Case "RT": Sheets("Rooster").Range("Q" & g) = "BHN"
            Case "PT": Sheets("Rooster").Range("Q" & g) = "PT"
        End Select
    Next g
End With

End Sub

内容的提问来源于stack exchange，提问作者SUNSHINE