TextToColumns运行时错误'424'需要对象

时间:2014-12-08 16:36:14

标签: excel vba excel-vba

我正在尝试在所有打开的工作簿上运行TextToColumns宏。这个宏适用于1本书。即我打开一本书然后运行宏。但是当我尝试通过另一个VBA宏在所有打开的工作簿上运行它时,我得到了运行时错误' 424'需要对象。

我尝试过多种方法来解决这个问题。此外,如果我只是单步执行宏(按住F8),宏运行正常。

以下是A栏:

6/10/2014 0:02

它一直复制到底部。

Sub S()
Dim wbkx As Workbook
    For Each wbkx In Application.Workbooks
        wbkx.Activate
        Worksheets(1).Select
        Columns("A:A").Select
        If Selection.Column <> "" Then
            Call WTF
        Else
            MsgBox ("Fail!")
        End If
    Next wbkx
End Sub

Sub WTF()
        Selection.TextToColumns Destination:=Range("I1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(9, 1), Array(18, 1)), TrailingMinusNumbers:= _
        True
        Columns("I:I").Select
        Selection.Cut
        Columns("A:A").Select
        ActiveSheet.Paste
        Columns("A:A").EntireColumn.AutoFit
        Columns("J:K").Select
        Selection.Delete Shift:=xlToLeft
End Sub

1 个答案:

答案 0 :(得分:0)

使用选择被认为是不好的做法。另外,我认为你不需要两个潜艇:

Sub S()
Dim wbkx As Workbook, SelSht As Worksheet, LastRow As Long, CurRow As Long, _
    DateA As String, YearA As String, MonthA As String, DayA As String
    For Each wbkx In Application.Workbooks
        wbkx.Activate
        Set SelSht = wbkx.Worksheets(1)
        LastRow = SelSht.Range("A" & Rows.Count).End(xlUp).Row
        For CurRow = 1 To LastRow
            DateA = SelSht.Range("A" & CurRow).Value
            MonthA = Mid(DateA, 1, InStr(1, DateA, "/") - 1)
            DayA = Mid(DateA, InStr(1, DateA, "/") + 1, (InStr(InStr(1, DateA, "/") + 1, DateA, "/") - InStr(1, DateA, "/") - 1))
            YearA = Mid(DateA, InStr(InStr(1, DateA, "/") + 1, DateA, "/") + 1, (InStr(1, DateA, " ") - InStr(InStr(1, DateA, "/") + 1, DateA, "/") - 1))
            SelSht.Range("A" & CurRow).Value = DateSerial(CInt(YearA), CInt(MonthA), CInt(DayA))
        Next CurRow
    Next wbkx
End Sub