Excelにて、ユーザーフォームのコンボボックスを使い日付検索を追加したいのですが、ご教授願います

Excelにて、現在、ユーザーフォームのコンボボックスを使い検索をしています
検索条件として、コンボボックス１（請求先）、コンボボックス２（検索月）にて検索を
行っていたのですが、年が変わると年度の検索ができないため
今回、コンボボックス３（検索年）追加してコンボボックス１，２，３の条件で検索をしたいのですが
私には難しすぎて、何処を変えて追加するのか分からず困っています。どなたかご教授願います
下記、現在のコードです


Dim Sh(1) As Worksheet '検索開始
Dim Cri As Range
Dim St As String
Dim D1 As Date
Dim D2 As Date

Set Sh(0) = Worksheets("印刷済")
Set Sh(1) = Worksheets("月請求書データー")
Sh(1).Cells.Clear
D1 = DateSerial(Year(Date), ComboBox2.Value, 1)
'(ComboBox2.Value)の月の初日

D2 = DateSerial(Year(Date), ComboBox2.Value + 1, 1)
'(ComboBox2.Value + 1)の月の初日

If WorksheetFunction.CountIfs(Sh(0).Columns(3), ComboBox1.Value, _
Sh(0).Columns(2), ">=" & D1, Sh(0).Columns(2), "<" & D2) Then
'C列の値がCombobox1.Value 且つ B列の日付が D1以上 D2未満

Set Cri = Sh(0).Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(2)
'フィルタ抽出条件のセル範囲
'印刷済 シート (右端列+1)の1行目と2行目

St = "=AND(B2>=DATE(#,@,1),B2<DATE(#,@+1,1),C2=""\"")"

St = Replace(St, "#", Year(Date))
'"#"の箇所を、本日の年 に置換

St = Replace(St, "\", ComboBox1.Value)
'"\" の箇所を、ComboBox1.Valueに置換

St = Replace(St, "@", ComboBox2.Value)
'"@" の箇所を、ComboBox2.Valueに置換

Cri.Cells(2).Formula = St
'抽出用の数式をセット

Sh(0).Range("A:A").Resize(, Cri.Column - 1).AdvancedFilter _
xlFilterCopy, Cri, Sh(1).Cells(1)
Cri.Clear
MsgBox "抽出しました"
Else
MsgBox "抽出データがありません"
End If
ご教授願います

質問者からの補足コメント

• ありがとうございます。
  ファイルの書式は変更できない為、現状で行いたいのですが、
  無理でしょうか

  No.1の回答に寄せられた補足コメントです。 補足日時：2021/02/18 12:44

No.1 回答者： ppp2122 回答日時： 2021/02/18 08:24

日付は　年と月のセルを作ったほうが良い　

そして　年と月でAnd検索をかける

No.2 ベストアンサー 回答者： Zincer 回答日時： 2021/02/18 13:39

要は「Date」で操作当日の日付を強制的に使用しているのが原因で、これにコンボボックス３（検索年）で指定できるようになればいいので、

＞St = Replace(St, "#", Year(Date))
＞'"#"の箇所を、本日の年 に置換
を
St = Replace(St, "#", ComboBox3.Value)
のように
「Year(Date)」を「ComboBox3.Value」に変えると良いのでは？
その前にも「Year(Date)」が「D1=」と「D2=」にも使用されていますね。

この回答へのお礼

ありがとうございます。
うまくいきました。
感謝いたします

お礼日時：2021/02/21 14:39

No.3 回答者： ppp2122 回答日時： 2021/02/18 13:42

なら　日付データから　関数で年と時間を取り出して

検索をかければ良いですね

この回答へのお礼

ありがとうございました。
参考にさせて頂きます。

お礼日時：2021/02/21 14:38