質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.45%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

1230閲覧

【VBA】Inputboxで存在しない日付を入れたらエラーになるように条件分岐させたい

koburon

総合スコア30

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2023/01/19 10:00

前提

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」の間で、以下の条件の場合、エラーメッセージを表示させるようにコードを追加したいです。

  1. あり得ない日付を入力した場合(「2023/4/31」など)
  2. 「区分=2」かつ「入力した日付」で一致する社員がいない場合

試したこと

ElseIf dval = IsError(d) Then 'あり得ない日付を入力した場合 MsgBox ("あり得ない日付です")

下記の参考URLを元にコードを書いてみたのですが、
以下のようにエラーになってしまいました。

実行時エラー'13': 型が一致しません。

オートフィルタで一致しない場合のコードも併せて修正する方法をアドバイスいただければ幸いです。
よろしくお願いいたします。

補足情報(FW/ツールのバージョンなど)

PC:Windows11
ソフト:Microsoft365 Excel
参考URL:VBA IsError 関数:エラーかどうかを判定する

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

日付がエラーの場合は、日付の再入力に戻ります。
入力日付に該当する社員がいない場合は、エラーメッセージを表示後、処理を終了します。
(入力日付に該当する社員がいない場合も日付の再入力に戻るようにするには、できないことはありませんが、多少コードが汚くなります。)

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 ElseIf IsDate(dval) = False Then 36 '入力日付が正しくない場合 37 MsgBox ("あり得ない日付です") 38 Else 39 '入力日付は正しい場合 40 '(必要があれば入力日付のチェックを行い、エラーなら再入力する) 41 d = CDate(dval) 42 flag = True 43 End If 44 Loop 45 46 '異動者リストで3行目以降をクリアする 47 wS2.Rows("3:" & Rows.Count).ClearContents 48 49 'オートフィルタで区分データを抽出する 50 '(抽出する区分は2) 51 wS1.Range("A1").AutoFilter Field:=1, Criteria1:="2" 52 53 'オートフィルタで入力した日付を抽出する 54 wS1.Range("A1").AutoFilter Field:=2, Criteria1:=Format(d, strDateFormat) 55 56 'オートフィルタ結果の行数をカウントする 57 rg = "D1:D" & wS1.Range("D1").CurrentRegion.Rows.Count 58 cnt = WorksheetFunction.Subtotal(103, wS1.Range(rg)) 59 60 '1行のみの場合(見出し行のみ)終了する 61 If cnt = 1 Then 62 MsgBox ("該当社員は存在しません") 63 Exit Sub 64 End If 65 66 '抽出した社員番号をコピーして貼り付ける 67 LastRow = wS1.Cells(Rows.Count, "D").End(xlUp).Row 68 wS1.Range("D1").CurrentRegion.Range("D1").Offset(1, 0).Resize(LastRow - 1, 1).Copy wS2.Range("A3") 69 70 Application.ScreenUpdating = True 71 72End Sub 73

投稿2023/01/19 11:28

tatsu99

総合スコア5474

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

koburon

2023/01/20 00:18

回答ありがとうございます。 あり得ない日付のパターンはElse Ifに組み込むところまでは想像できましたが、 該当しない社員のパターンをどこに組み込むかがよくわかりませんでした。 オートフィルタした結果で判断させればよいという発想ですね。 ベストアンサーとさせていただきます。 ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.45%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問