在VBA中找不到单元格时的错误处理程序(错误1004)

时间:2017-11-06 11:25:44

标签: excel excel-vba vba

我差不多完成了我的宏,但我正在努力处理错误处理程序。我想要的是消息"没有找到数据"并退出Sub,但我不确定将代码放在我的宏中的确切位置:

Sub test()

Dim src As Worksheet
Dim tgt As Worksheet
Dim filterRange As Range
Dim copyRange As Range
Dim lastRow As Long

Set src = ThisWorkbook.Sheets(1)
Set tgt = ThisWorkbook.Sheets(2)

src.AutoFilterMode = False

lastRow = src.Range("J" & src.Rows.Count).End(xlUp).Row
On Error Resume Next
Set filterRange = src.Range("A1:Q" & lastRow)
On Error GoTo 0
Set copyRange = src.Range("A2:Q" & lastRow)

filterRange.AutoFilter Field:=1, Criteria1:=RGB(255, 199, 206), Operator:=xlFilterCellColor
filterRange.AutoFilter Field:=16, Criteria1:="yes"

With tgt
    copyRange.SpecialCells(xlCellTypeVisible).copy
If copyRange Is Nothing Then
    src.AutoFilterMode = False
    MsgBox "No data found"
    Exit Sub
Else
    tgt.Range("A65536").End(xlUp).Offset(1).PasteSpecial
    src.AutoFilterMode = False
    MsgBox "Data found and updated"
End If
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = False

End Sub

换句话说,我想摆脱运行时错误' 1004'。

1 个答案:

答案 0 :(得分:1)

这可能是最懒的方式:

Sub test()

    On Error GoTo test_Error

    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim filterRange As Range
    Dim copyRange As Range
    Dim lastRow As Long

    Set src = ThisWorkbook.Sheets(1)
    Set tgt = ThisWorkbook.Sheets(2)

    src.AutoFilterMode = False

    lastRow = src.Range("J" & src.Rows.Count).End(xlUp).Row
    Set filterRange = src.Range("A1:Q" & lastRow)
    Set copyRange = src.Range("A2:Q" & lastRow)

    filterRange.AutoFilter Field:=1, Criteria1:=RGB(255, 199, 206), Operator:=xlFilterCellColor
    filterRange.AutoFilter Field:=16, Criteria1:="yes"

    With tgt
        copyRange.SpecialCells(xlCellTypeVisible).Copy
        If copyRange Is Nothing Then
            src.AutoFilterMode = False
        Else
            tgt.Range("A65536").End(xlUp).Offset(1).PasteSpecial
            src.AutoFilterMode = False
            MsgBox "Data found and updated"
        End If
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False


   On Error GoTo 0
   Exit Sub

test_Error:

    If Err.Number = 1004 Then
        MsgBox "No data found"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure test of Sub Modul1"
    End If

End Sub

只需在底部添加一个erorr处理程序,检查错误号1004并添加所需的消息框。