2017-11-06 8 views
1

私はほとんどマクロを使用していますが、エラーハンドラーでは苦労しています。私が欲しいのは、メッセージ「データが見つかりません」と終了サブですが、私は私のマクロのコードを入れて場所を正確に確認していない。つまりVBAでセルが見つからない場合のエラーハンドラー(エラー1004)

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

これはおそらくそれを行うにはもっとも怠慢な方法です:

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をチェックし、必要なメッセージボックスを追加します。

関連する問題