Question

在Excel 2007上构建的宏运行时间过长，最后显示错误消息

＆＃34;运行时错误1004 - 范围类的pastespecial方法失败＆＃34;。

虽然相同的宏在Excel 2007中运行良好，但在30秒内完成，没有任何错误。

请检查并提出建议。

代码开始：

Sub Import()
    Dim SourceFile As Workbook
    Dim SourceTab As Worksheet
    Dim TargetTab As Worksheet

    SourceFileName = Application.GetOpenFilename("Excel Files ,     *.xlt;*.xls;*.xlsx;*.csv")

    If SourceFileName = False Then Exit Sub
    Application.ScreenUpdating = False

    Set TargetTab = Sheets("Output")
    TargetRow = TargetTab.Cells(TargetTab.Cells.Rows.Count, 3).End(xlUp).Row + 1

    Set SourceFile = Workbooks.Open(SourceFileName)

    SourceFile.Activate
    Set SourceTab = Sheets("Sheet1")
    SourceTab.Activate

    For i = 1 To Cells(Cells.Rows.Count, 2).End(xlUp).Row

        If Len(Cells(i, 2).Value) = 2 Then

            Cells(i, 3).Value = Cells(i, 31).Value
            Cells(i, 31).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 3).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 5).Value = Cells(i, 11).Value
            Cells(i, 11).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 5).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 6).Value = Cells(i, 19).Value
            Cells(i, 19).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 6).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 7).Value = Cells(i, 27).Value
            Cells(i, 27).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 7).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 9).Value = Cells(i, 4).Value
            Cells(i, 4).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 9).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 11).Value = Cells(4, 5).Value
            Cells(4, 5).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 11).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 13).Value = Cells(2, 25).Value
            Cells(2, 25).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 13).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 14).Value = Cells(i, 43).Value
            Cells(i, 43).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 14).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            Cells(i, 17).Value = Cells(i, 8).Value
            Cells(i, 8).Resize(1, 1).Copy
            ThisWorkbook.Activate
            TargetTab.Activate
            Cells(TargetRow, 17).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            SourceFile.Activate

            TargetRow = TargetRow + 1
            'TargetNewRows = TargetNewRows + 1
        End If
    Next
    SourceFile.Close False
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Answer 1

这类事：

Cells(i, 6).Value = Cells(i, 19).Value
     Cells(i, 19).Resize(1, 1).Copy
        ThisWorkbook.Activate
        TargetTab.Activate
        Cells(TargetRow, 6).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        SourceFile.Activate

会更好：

SourceTab.Cells(i, 6).Value = SourceTab.Cells(i, 19).Value
TargetTab.Cells(TargetRow, 6).Value = SourceTab.Cells(i, 19).Value

跳过所有不需要的Select / Activate调用，使您的代码可能意外失败。在可能的情况下，您的代码应该不依赖于任何特定范围，工作表或工作簿的活动/选择。

VBA不能在Excel 365专业版中使用 - ＆＃39;范围类的粘贴特殊方法失败＆＃39;

1 个答案: