前提
VBAで任意の日に異動した社員のリストを出力するマクロを作っています。
使用するブックは1枚で、シートは以下の2枚です。
【異動DB】
【異動者リスト】
該当のソースコード
ボタンをクリックするとダイアログが開き、任意の日付(例:2023/1/1)を入力して「OK」をクリックすると、【異動DB】のA列で「2」、B列で「入力した年月日」でオートフィルタされ、抽出された社員番号をコピーして、【異動者リスト】のA列に貼り付けるマクロです。
VBA
1Sub idou() 2'異動者リストを作成する 3 4 '任意の日の異動者を抽出する 5 Application.ScreenUpdating = False 6 7 Dim d As Date 8 Dim dval As String 9 Dim flag As Boolean 10 Dim i As Long 11 Dim cnt As Long 12 Dim LastRow As Long 13 Dim rg As String 14 15 Dim strDateFormat As String 16 Dim wS1 As Worksheet 17 Dim wS2 As Worksheet 18 19 'ワークシートを変数で宣言する 20 Set wS1 = Worksheets("異動DB") 21 Set wS2 = Worksheets("異動者リスト") 22 23 flag = False 24 strDateFormat = wS1.Range("B2").NumberFormatLocal 25 26 Do While flag = False 27 dval = InputBox("基準日を入力(記入例:1900/1/1)") 28 If StrPtr(dval) = 0 Then 29 'キャンセル又は右上の×をクリックした場合 30 Exit Sub 31 ElseIf dval = "" Then 32 'なにも入力しないでOKをクリックした場合 33 MsgBox ("何も入力されていません") 34 35 Else 36 '上記以外 37 '入力日付は正しいものとする 38 '(必要があれば入力日付のチェックを行い、エラーなら再入力する) 39 d = CDate(dval) 40 flag = True 41 End If 42 Loop 43 44 '異動者リストで3行目以降をクリアする 45 wS2.Rows("3:" & Rows.Count).ClearContents 46 47 'オートフィルタで区分データを抽出する 48 '(抽出する区分は2) 49 wS1.Range("A1").AutoFilter Field:=1, Criteria1:="2" 50 51 'オートフィルタで入力した日付を抽出する 52 wS1.Range("A1").AutoFilter Field:=2, Criteria1:=Format(d, strDateFormat) 53 54 'オートフィルタ結果の行数をカウントする 55 rg = "D1:D" & wS1.Range("D1").CurrentRegion.Rows.Count 56 cnt = WorksheetFunction.Subtotal(103, wS1.Range(rg)) 57 58 '1行のみの場合(見出し行のみ)終了する 59 If cnt = 1 Then Exit Sub 60 61 '抽出した社員番号をコピーして貼り付ける 62 LastRow = wS1.Cells(Rows.Count, "D").End(xlUp).Row 63 wS1.Range("D1").CurrentRegion.Range("D1").Offset(1, 0).Resize(LastRow - 1, 1).Copy wS2.Range("A3") 64 65 Application.ScreenUpdating = True 66 67End Sub
発生している問題・エラーメッセージ
ダイアログに何か日付を入力して「OK」をクリックすると、該当する日付が一致すれば【異動者リスト】に値がコピーされますが、該当しない日付やあり得ない日付を入力して「OK」をクリックすると何も起きずに処理が終了します。
実現したいこと
「Do~Loop」の間で、以下の条件の場合、エラーメッセージを表示させるようにコードを追加したいです。
- あり得ない日付を入力した場合(「2023/4/31」など)
- 「区分=2」かつ「入力した日付」で一致する社員がいない場合
試したこと
ElseIf dval = IsError(d) Then 'あり得ない日付を入力した場合 MsgBox ("あり得ない日付です")
下記の参考URLを元にコードを書いてみたのですが、
以下のようにエラーになってしまいました。
実行時エラー'13': 型が一致しません。
オートフィルタで一致しない場合のコードも併せて修正する方法をアドバイスいただければ幸いです。
よろしくお願いいたします。
補足情報(FW/ツールのバージョンなど)
PC:Windows11
ソフト:Microsoft365 Excel
参考URL:VBA IsError 関数:エラーかどうかを判定する

回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2023/01/20 00:18