【VBA】オートフィルタで指定した日付のデータを抽出したい

前提

VBAで任意の日付で異動した社員リストを出力するマクロを作っています。
ボタンをクリックするとダイアログが開き、任意の日付(例：2023/1/1)を入力して「OK」をクリックすると、その日付の異動者リストが別シートに出力されるマクロです。

区分	年月日	社員番号	氏名	所属
0	2022/4/1	11111	田中太郎	本社
1	2022/4/1	22222	鈴木次郎	関東支社
1	2022/9/1	33333	山本三郎	中部支社
2	2022/4/1	44444	遠藤花子	関西支社
2	2022/9/1	55555	小林四郎	九州支社

※1列目の区分は0:異動無し、1:新規入社、2:異動または退職

該当のソースコード

上記の表を記載している「異動DB」を以下の2つの条件でオートフィルタして、該当する社員の「社員番号」「氏名」「所属」の3項目を「異動者リスト」に貼り付けるコードです。

「区分」の値が「2」(異動または退職)
「年月日」の値がダイアログで記入した年月日

VBA
1Sub idoulist()
2'任意の日の異動者リストを出力する
3
4    Application.ScreenUpdating = False
5    Dim d As Date
6    Dim dval As String
7    Dim flag As Boolean
8    Dim myRow As Long
9    flag = False
10    Do While flag = False
11        dval = InputBox("基準日を入力(記入例：1900/1/1)")
12        If StrPtr(dval) = 0 Then
13            'キャンセル又は右上の×をクリックした場合
14            Exit Sub
15        ElseIf dval = "" Then
16            'なにも入力しないでOKをクリックした場合
17            MsgBox ("何も入力されていません")
18        Else
19            '上記以外
20            '入力日付は正しいものとする
21            '（必要があれば入力日付のチェックを行い、エラーなら再入力する）
22            d = CDate(dval)
23            flag = True
24        End If
25    Loop
26    
27        '抽出する日付を記入する
28        Worksheets("異動DB").Activate
29        Worksheets("異動DB").Range("R1") = d
30        
31    
32        'オートフィルタでデータを抽出する
33        Worksheets("異動DB").Range("A1").AutoFilter Field:=1, Criteria1:="2"
34        Worksheets("異動DB").Range("A1").AutoFilter Field:=2, Criteria1:=d
35        
36        '抽出するデータの最終行を求める
37        myRow = Worksheets("異動DB").Range("A" & Rows.Count).End(xlUp).Row
38        
39        '貼り付け先をクリアする
40        Worksheets("異動者リスト").Activate
41        Worksheets("異動者リスト").Range("3:16").Clear
42        
43        '抽出したデータをコピーして貼り付け
44        Worksheets("異動DB").Activate
45        Worksheets("異動DB").Range("D2:F" & myRow).Copy Worksheets("異動者リスト").Range("A3")
46        
47        '先頭にタイトルをつける
48        Range("A1").Select
49        Worksheets("異動者リスト").Range("a1") = d & "異動者リスト"
50        
51     Application.ScreenUpdating = True
52     
53End Sub

発生している問題・エラーメッセージ

ダイアログに日付（例えば、「2022/4/1」）を入力して「OK」をクリックするとエラーを出すことなく処理が終了しますが、以下表のように1件もヒットせず表示されてしまいます。
フィルタを確認すると、「区分」は「2」で正しく抽出されていますが、「年月日」は全てチェックが外れていました。

区分	年月日	社員番号	氏名	所属

実現したいこと

「年月日」を記入した日付でフィルタをかけたいです。

試したこと

原因を調べたところ、日付でオートフィルタをかける際、Valueプロパティが異なると失敗するようなので、以下のコードで「異動DB」のR1セルおよびB列（「年月日」）のセルの書式設定を確認したところ、いずれも「yyyy/m/d」でした。

VBA
1Sub セル書式設定取得()
2
3Dim s As String
4s = Range("R1").NumberFormatLocal
5    
6    ' ダイアログボックスに結果を表示
7    MsgBox  s 
8
9End Sub

書式設定は同じように見えますが、何か原因があって異なると判断されているのでしょうか。
日付を正しくオートフィルタがかけられる方法をご教示いただければと思います。
よろしくお願いいたします。

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

PC：Windows11
ソフト：Microsoft365 Excel

参考にしたURL:
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/prog/prog04.html

行動規範の内容に同意します

回答1件

ベストアンサー

参考記事: Office TANAKA: 日付で絞り込む

Worksheets("異動DB").Range("A1").AutoFilter Field:=2, Criteria1:=d

vba
1Dim strDateFormat As String
2strDateFormat = Worksheets("異動DB").Range("B2").NumberFormatLocal
3Worksheets("異動DB").Range("A1").AutoFilter Field:=2, Criteria1:=Format(d, strDateFormat)