エクセルで指定した数字を含む検索について

質問

初歩的な質問で申し訳ございません。
添付のような表があり、現在はA列にオートフィルタをかけて数字下二桁を入力後、ソートがかかった商品表示され、日付の
列に個数の入力を行っています。（A列の番号は20桁位あるので、実際は下4桁で検索しています。）
【現在の作業】
A列にオートフィルタから下4桁入力後に検索→日付の列に個数を入力→また検索
【理想の作業】
ある程度、検索する商品の番号の下４桁をどこかに候補として挙げ、その数字を含む行だけ表示→一気に個数だけ入力
VBAでもマクロの記録でも何かよい方法はございませんでしょうか？
イメージとしては、1行目から5行目にあるオレンジのボックスの中に検索したい商品の番号4桁をいくつか入力し、それに該当する商品だけを7行目のA列から検索し、その枠ごとに記載された数字を含む行のみソートされ表示されるようにできると助かります。

どうぞよろしく御願いいたします！初歩的な質問で申し訳ございません。
添付のような表があり、現在はA列にオートフィルタをかけて数字下二桁を入力後、ソートがかかった商品表示され、日付の
列に個数の入力を行っています。（A列の番号は20桁位あるので、実際は下4桁で検索しています。）
【現在の作業】
A列にオートフィルタから下4桁入力後に検索→日付の列に個数を入力→また検索
【理想の作業】
ある程度、検索する商品の番号の下４桁をどこかに候補として挙げ、その数字を含む行だけ表示→一気に個数だけ入力
VBAでもマクロの記録でも何かよい方法はございませんでしょうか？
イメージとしては、1行目から5行目にあるオレンジのボックスの中に検索したい商品の番号4桁をいくつか入力し、それに該当する商品だけを7行目のA列から検索し、その枠ごとに記載された数字を含む行のみソートされ表示されるようにできると助かります。

どうぞよろしく御願いいたします！

回答No.1

nishi6

下２桁なのか４桁なのかよく分かりませんが、４桁として、多分こんなことなのかなと想像しての解答です。

添付図のようなものを考えてみました。
ボタンをクリックすると、B1:F4の4行×5列に入力した値で順にフィルターをかけます。B1が終わると、B2→B1、B3→B2、B4→B3、C1→B4、C2→C1のように動きます。

○フィルター用の表はA6の表題からです。

○CommandButton1はフィルターを掛けて絞り込み用のデータを進めます。
　フィルターではセルB1の値を使います。

○絞り込み用のデータをあらかじめ入力しておく場所を、B1:F4の4行×5列にしています。
モジュールにはこの行数、列数の数値をセットしています。モジュールの意味が分かったら、シートの方の列数を増やして、モジュールの数値も合わせて変えてみてください。セットしておくデータを増やせます。

○添付図を見てもらえば分かると思いますが、H列、I列にも同じ数値があります。ボタンを押すごとにセルB1から消えていくので、H列、I列～に残しておけば次回も使えるかなというくらいの意味合いです。これは必須ではありません。

「シートのコードウィンドウに貼り付けます」

Const maxRow = 4　　 '番号を入力しておく表の行数
Const maxColumn = 5　'番号を入力しておく表の列数

Private Sub CommandButton1_Click()
　　'フィルターがセットされていたら解除する
　　If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

　　'フィルター
　　'　　A6はフィルターの左上セル
　　'　　B1はフィルターの条件を入力したセル
　　ActiveSheet.Range("A6").AutoFilter Field:=1, _
　　　　　　　　Criteria1:="=*" & Range("B1"), Operator:=xlAnd

　　'登録情報を進める
　　Dim r As Integer, c As Integer '行・列カウンタ
　　With Range("A1")
　　　　For c = 1 To maxColumn
　　　　　　For r = 1 To maxRow - 1
　　　　　　　　'上に詰める
　　　　　　　　.Offset(r - 1, c) = .Offset(r, c)
　　　　　　Next
　　　　　　'一番上を前列の一番下にする
　　　　　　.Offset(r - 1, c) = .Offset(0, c + 1)
　　　　Next
　　End With
End Sub