【エクセルVBA入門】エラーが発生したときに分岐処理を追加する方法

photo credit: kolix incomplete walk via photopin (license)

みなさん、こんにちは！
タカハシ(@ntakahashi0505)です。

エクセルVBAでバラバラの経費精算書ファイルのデータを収集するマクロの作り方をお伝えしています。

前回の記事はコチラ。

【エクセルVBA入門】Vlookupメソッドを使ったときに発生するエラーを回避する方法

エクセルVBAでバラバラの経費精算書を一つのデータベースにまとめるマクロの作り方についてお伝えしています。今回はVLookupメソッドを使ったときに発生するエラーを回避する方法についてお伝えします。

VLookupメソッドが失敗しても処理を継続するためにOn Error Resume Nextステートメントを追加しました。

ただ、エラーが発生したことがわかりづらくなっちゃったんですよね。

ということで、今回はエクセルVBAでエラーが発生したときにメッセージを表示する処理を追加する方法をお伝えしていきます。

では、行ってみましょう！

前回のおさらい
Errオブジェクトとは
1. Numberプロパティを使ってエラーの発生で分岐
2. On Error GoTo 0でエラーハンドラーを無効化する
エラー処理を加えた経費精算データ収集マクロ
まとめ
連載目次：エクセルVBAで経費データをデータベースに集約する

前回のおさらい

前回作成したコードはコチラです。

Sub 経費精算データ取り込み()

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim di As Long: di = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim f As File
For Each f In fso.GetFolder(ThisWorkbook.Path & "\data").Files
    With Workbooks.Open(f.Path)
        With .Worksheets(1)
            
            Dim period As String: period = Left(f.Name, 6)
            Dim month As Date: month = DateSerial(Left(period, 4), Right(period, 2), 1)
                                    
            On Error Resume Next
            Dim staffId As Long: staffId = Val(Right(Replace(f.Name, ".xlsx", ""), 4))
            Dim staffName As String: staffName = WorksheetFunction.VLookup(staffId, wsStaff.Range("A:D"), 2, False)
            Dim departmentId As Long: departmentId = WorksheetFunction.VLookup(staffId, wsStaff.Range("A:D"), 3, False)
            Dim departmentName As String: departmentName = WorksheetFunction.VLookup(staffId, wsStaff.Range("A:D"), 4, False)
                      
            Dim i As Long: i = 12
            Do While .Cells(i, 1).Value <> ""
                wsData.Cells(di, 1).Value = month '1 対象月
                wsData.Cells(di, 2).Value = .Cells(i, 1).Value '2 日付
                wsData.Cells(di, 3).Value = departmentId  '3 部署No
                wsData.Cells(di, 4).Value = departmentName '4 部署
                wsData.Cells(di, 5).Value = staffId '5 社員No
                wsData.Cells(di, 6).Value = staffName '6 氏名
                wsData.Cells(di, 7).Value = .Cells(i, 2).Value '7 科目
                wsData.Cells(di, 8).Value = .Cells(i, 5).Value '8 摘要
                wsData.Cells(di, 9).Value = .Cells(i, 6).Value '9 金額
                wsData.Cells(di, 10).Value = .Cells(i, 7).Value '10 備考
                i = i + 1: di = di + 1
            Loop
        End With
        .Close
    End With
Next f

End Sub

15行目にOn Error Resume Nextステートメントを入れたことで、その後のVLookupメソッドが失敗したとしても、処理を続行するようになりました。

ただ、その場合の結果がコチラですね。

正しくないデータが入ってしまいました。

もっとエラーが発生したことがわかるようにしたいですよね。

Errオブジェクトとは

そんな時のためにErrオブジェクトを使って、もう少しエラーが発生したことをわかりやすくしてあげましょう。

Errオブジェクトには、エラーが発生したときにどんなエラーが発生したのかという情報が格納されます。

これを使ってエラーが発生したときに何らかのアクションを起こすという処理を追加することができます。

Numberプロパティを使ってエラーの発生で分岐

ErrオブジェクトのNumberプロパティには初期値は0が格納されていて、エラーが発生するとエラーの種類に応じて0より大きい番号が格納されます。

Errオブジェクト.Number

例えば、以下のエラーメッセージであれば「1004」がエラーの番号になります。

ですから例えば、以下のようなコードを挿入すると

If Err.Number <> 0 Then
    MsgBox f.Name & " の処理でエラーが発生しました。"
End If

それ以前にエラーが発生していれば、メッセージダイアログが表示されます。

On Error GoTo 0でエラーハンドラーを無効化する

しかし、一点問題がありまして、On Error Resume Nextステートメントは、VLookupメソッド以外のエラーについても継続をしてしまいます。

想定していないエラーまで、全てもみ消してしまうわけです。

それはそれで問題ですので、On Error GoTo 0ステートメントで、エラーハンドラーを無効化します。

On Error GoTo 0

「エラーが発生したら0行目に飛ぶ」、みたいな命令に見えますが、そうではなくて

On Error～で有効になっているエラーハンドラーを無効化する
Errオブジェクトを初期化する

という役割を果たします。

つまり、今回の場合は、On Error Resume Nextの効果をかき消して、さらにErrオブジェクトをリセット（Numberプロパティも0に）することになります。

エラー処理を加えた経費精算データ収集マクロ

以上を踏まえたコードはこちらになります。

Sub 経費精算データ取り込み()

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim di As Long: di = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim f As File
For Each f In fso.GetFolder(ThisWorkbook.Path & "\data").Files
    With Workbooks.Open(f.Path)
        With .Worksheets(1)
            
            Dim period As String: period = Left(f.Name, 6)
            Dim month As Date: month = DateSerial(Left(period, 4), Right(period, 2), 1)
                                    
            On Error Resume Next
            Dim staffId As Long: staffId = Val(Right(Replace(f.Name, ".xlsx", ""), 4))
            Dim staffName As String: staffName = WorksheetFunction.VLookup(staffId, wsStaff.Range("A:D"), 2, False)
            Dim departmentId As Long: departmentId = WorksheetFunction.VLookup(staffId, wsStaff.Range("A:D"), 3, False)
            Dim departmentName As String: departmentName = WorksheetFunction.VLookup(staffId, wsStaff.Range("A:D"), 4, False)

            If Err.Number <> 0 Then
                MsgBox f.Name & " の処理でエラーが発生しました。"
                staffId = 0
                staffName = ""
                departmentId = 0
                departmentName = ""
            End If
            On Error GoTo 0
                      
            Dim i As Long: i = 12
            Do While .Cells(i, 1).Value <> ""
                wsData.Cells(di, 1).Value = month '1 対象月
                wsData.Cells(di, 2).Value = .Cells(i, 1).Value '2 日付
                wsData.Cells(di, 3).Value = departmentId  '3 部署No
                wsData.Cells(di, 4).Value = departmentName '4 部署
                wsData.Cells(di, 5).Value = staffId '5 社員No
                wsData.Cells(di, 6).Value = staffName '6 氏名
                wsData.Cells(di, 7).Value = .Cells(i, 2).Value '7 科目
                wsData.Cells(di, 8).Value = .Cells(i, 5).Value '8 摘要
                wsData.Cells(di, 9).Value = .Cells(i, 6).Value '9 金額
                wsData.Cells(di, 10).Value = .Cells(i, 7).Value '10 備考
                i = i + 1: di = di + 1
            Loop
        End With
        .Close
    End With
Next f

End Sub

21～28行目が追加した処理ですね。

実行時エラーが発生したときに、メッセージの表示に加えて、マスタから取得すべきデータを0または空にしています。

エラーが発生した場合、以下のようなメッセージが表示されつつ