宏错误处理

时间:2015-12-03 13:12:38

标签: excel excel-vba vba

我使用Excel中的“记录宏”按钮创建基本宏。然后我进行相应的编辑,让宏做我想做的事。

在这种情况下,我手动打开master.xlsx文件。然后我在master.xlsx中运行一个名为week12的宏。

此宏打开一个名为Grant.xlsx的文件,复制单元格H16的内容,然后将内容粘贴到master.xlsx单元格N3中。

我遇到的问题是,如果文件不存在,我会收到一条消息,说该文件无法找到,然后我收到运行时错误' 1004'

宏的目的是打开40个不同的电子表格并复制单元格的内容并将其粘贴到master.xlsx中。 40个文件中的任何一个或多个都可能丢失。下面的宏示例仅显示40中的2的宏。

Sub Week12()
    '
    ' Week12 Macro
    '
    '   Grant

    '
        If Err.Number > 0 Then
        Err.Clear
        End If

        On Error GoTo 3

        Sheets("SCORES").Select
        Range("A1").Select
        ChDir _
            "K:\\\Grant"
        Workbooks.Open Filename:= _
            "K:\\\\Week 12.xlsx"
        Range("H16").Select
        Selection.Copy
        Windows("Master.xlsb").Activate
        Range("N3").Select
        ActiveSheet.Paste
        Range("A1").Select
        Windows("Week 12.xlsx").Activate
        ActiveWindow.Close
        GoTo 4
    3:
    'if the file is missing put a O in N3

        Range("N3").Select
        ActiveCell.FormulaR1C1 = "O"
        Range("A1").Select
        If Err.Number > 0 Then
        Err.Clear
        End If
    4:
    '   Adele

        On Error GoTo 5

        Sheets("SCORES").Select
        Range("A1").Select
        ChDir _
            "K:\\\\Adele"
        Workbooks.Open Filename:= _
            "K:\\\\Adele\Week 12.xlsx"
        Range("H16").Select
        Selection.Copy
        Windows("Master.xlsb").Activate
        Range("N4").Select
        ActiveSheet.Paste
        Range("A1").Select
        Windows("Week 12.xlsx").Activate
        ActiveWindow.Close
        GoTo 6
    5:
    'if the file is missing put a O in N4
        Range("N4").Select
        ActiveCell.FormulaR1C1 = "O"
        Range("A1").Select
        If Err.Number > 0 Then
        Err.Clear
        End If
    6:
    '   Stuart Manvell

    'and so on and so on for all 40 names
end sub

2 个答案:

答案 0 :(得分:2)

尝试以下操作,您需要根据自己的需要进行调整。

'Some Other Script here


'Ignore errors to allow for error evaluation
On Error Resume Next

ExcelFilePAth = "INSERT FILE PATH HERE"

'YAYAYA is just a random name
'Purpose is to generate an error if the File Path doesnt exisit
YAYAYA = GetAttr(ExcelFilePAth)

Select Case Err.Number

'If the File Path is valid the Error Number should be 0
'Else it will present an error message and then continue

    Case Is = 0

        'Insert your Script for processing the Excel Sheets Here

    Case Else


        'Insert what to do here

        MsgBox "The File path below doesnt exisit:" & vbNewLine & _
                vbNewLine & _
                ExcelFilePAth

End Select

'Resume error checking
On Error GoTo 0

'Some Other Script here

答案 1 :(得分:1)

我无法建立整个工作环境,但代码中有一些明显的区域可以循环执行程序。名称集合可以填充到一个大型数组中,这提供了循环的范围。对于每次迭代,在打开工作簿的文件夹名称中使用新名称。

Sub anyWQeek()
    Dim thisWeek As Long
    thisWeek = 12   '<~~ used below as Week & wk
    Weekly wk:=thisWeek 
End Sub

Sub Weekly(Optional wk As Long = 1)
    Dim v As Long, vNAMEs As Variant, var As Variant
    Dim nwb As Workbook, twb As Workbook

    Set twb = ThisWorkbook

    vNAMEs = Array("Grant", "Adelle", "Stuart", "Manville", _
                   "abc", "lorem", "ipsum", "blah", _
                   "blah-blah", "blah-blah-blah", "blh", "blah2")
                    'and so on and so on for all 40 names

    On Error GoTo bm_NextWorkbook

    For v = LBound(vNAMEs) To UBound(vNAMEs)
        var = 0
        ChDir "K:\\\" & vNAMEs(v)   '<~~ e.g. Grant
        Set nwb = Workbooks.Open(Filename:="K:\\\" & vNAMEs(v) & "\Week " & wk & ".xlsx", ReadOnly:=True)
        var = nwb.Worksheets(1).Range("H16").Value
        nwb.Close savechanges:=False
bm_NextWorkbook:
        twb.Sheets("SCORES").Range("N3").Offset(v, 0) = var
    Next v

End Sub

来自H16的零或值将转到相同位置,因此我将变量设置为 0 ,并且只有在根据计划完成所有内容时才覆盖该变量。无论如何,通过循环的迭代,该值被写入从N3偏移的单元格中。

我不完全确定H16的价值来自哪个工作表,所以我只选择了Worksheets(1)