分割払いの管理表

質問

自動口座振替契約者の内、次月の振替対象者を抽出したいです。月払、半年払、年払、一括払の４種の払込の方法があります。今はまだ契約者が少ないので手動でもなんとか探せるのですが、今後契約者が増加した際に手動にも限界が来そうな気がしたので、もし可能ならばと質問を投稿いたしました。。
現在管理している帳票から抽出できると大変助かるので、可不可も含めてご教示いただけませんでしょうか。

現在使用している帳票(1)
１行１名の契約者情報と振替日と振替実績を管理しています。
新規契約者は下の行に追加されていきます。
振替日は契約日を入力すると指定の払込方法に合わせて、２回目は〇年〇月〇日、３回目は□年□月□日、というように、最終の振替日まで自動的に表示されます。
　　 A B C D E F G H
1 契約番号　契約日　名前　口座　振替１回目　実績　２回目　 実績
2 1111111　2020/1/1　〇　　□　 2020/2/28　 〇 　2020/3/31　
3 2222222　2020/2/2　△　　■ 2020/3/31 　　 2020/4/30
4 3333333　2020/3/3　◎　　● 2020/4/30 2020/5/31

追加を考えている帳票(2)（次月振替対象者リストのようなもの）
A B C
１　振替予定日
２　2020/3/31
３
４　契約番号　 名前　 口座
５　1111111　 〇 □
６　2222222　 △ ■

帳票(1)(2)を利用するとした場合に、帳票(2)のA2に「2020/3/31」と入力すると５行目以降に該当するデータが表示されるようにしたい。

お力をお貸しくださる方、ご教示のほど宜しくお願いいたします。

回答No.2

HohoPapa · ベストアンサー

振替日はＨ列から始まるということでよければ
以下と思います。

Option Explicit

Sub sample()

　Dim RowCnt As Long
　Dim ColCnt As Long
　Dim PutCnt As Long
　Dim GetWsh As Worksheet
　Dim PutWsh As Worksheet
　Dim DatCol As Long

　With ThisWorkbook
　　Set GetWsh = .Sheets("Sheet1")
　　Set PutWsh = .Sheets("Sheet2")
　End With

　RowCnt = 2
　PutCnt = 4

　PutWsh.Rows("5:999").Delete　　'出力行範囲削除

　Do
　　If GetWsh.Cells(RowCnt, 1).Value = "" Then Exit Do
　　ColCnt = 8　'振替日が埋まる最初の列番号
　　Do
　　　If GetWsh.Cells(RowCnt, ColCnt).Value = "" Then Exit Do
　　　If GetWsh.Cells(RowCnt, ColCnt).Value >= _
　　　　　 PutWsh.Cells(2, 1).Value Then
　　　　PutCnt = PutCnt + 1
　　　　PutWsh.Cells(PutCnt, 1).Value = _
　　　　　GetWsh.Cells(RowCnt, 1).Value
　　　　For DatCol = 2 To 6
　　　　　PutWsh.Cells(PutCnt, DatCol).Value = _
　　　　　　GetWsh.Cells(RowCnt, DatCol + 1).Value
　　　　Next DatCol
　　　　Exit Do
　　　End If
　　　ColCnt = ColCnt + 2
　　Loop
　　RowCnt = RowCnt + 1
　Loop

End Sub

お礼

本当にありがとうございます！
ただいま出先の為、実際に利用させていただくのは明日となりますが、お礼だけでも先にと投稿させていただきました。
貴重なお時間を使ってご回答・ご教示いただき、心から感謝申し上げます。

回答No.1

HohoPapa

・振替日が指定日以降か？をチェックする
・振替日は、Ｅ列から右方向、1列おきに、左詰め
という条件、かつ、ＶＢＡでよければ
以下のコードでいかがでしょうか。

Sub sample()

　Dim RowCnt As Long
　Dim ColCnt As Long
　Dim PutCnt As Long
　Dim GetWsh As Worksheet
　Dim PutWsh As Worksheet

　With ThisWorkbook
　　Set GetWsh = .Sheets("Sheet1")
　　Set PutWsh = .Sheets("Sheet2")
　End With

　RowCnt = 2
　ColCnt = 5
　PutCnt = 4

　PutWsh.Rows("5:999").Delete　　'出力行範囲削除

　Do
　　If GetWsh.Cells(RowCnt, 1).Value = "" Then Exit Do
　　ColCnt = 5
　　Do
　　　If GetWsh.Cells(RowCnt, ColCnt).Value = "" Then Exit Do
　　　If GetWsh.Cells(RowCnt, ColCnt).Value >= _
　　　　　 PutWsh.Cells(2, 1).Value Then
　　　　PutCnt = PutCnt + 1
　　　　PutWsh.Cells(PutCnt, 1).Value = _
　　　　　GetWsh.Cells(RowCnt, 1).Value
　　　　PutWsh.Cells(PutCnt, 2).Value = _
　　　　　GetWsh.Cells(RowCnt, 3).Value
　　　　PutWsh.Cells(PutCnt, 3).Value = _
　　　　　GetWsh.Cells(RowCnt, 4).Value
　　　　Exit Do
　　　End If
　　　ColCnt = ColCnt + 2
　　Loop
　　RowCnt = RowCnt + 1
　Loop

End Sub

補足

HohoPapa様
本当にありがとうございます。感謝以外の言葉が見つかりません…。
もしお許しいただけるようであれば、今一度お力をお借りすることはできませんでしょうか。

Sheet1のC列「番号」の部分なのですが、現在「銀行名」「支店名」「種目」「口座番号」を合わせたものを記入しています。Sheet1のC列（名前）とD列（口座）の間に、３列足して、それぞれを単独で入力した場合も、Sheet2に同じように抽出することは可能でしょうか。

Sheet1
A B C D E F G
１　契番　契約日　名前　銀行名　支店名　種目　番号
２ 11111 2020/1/1 〇　　 □　　　△　　 ●　　■

Sheet2

１　振替予定日
２ （日付入力）
３
４　契約番号　　名前　銀行名　支店名　種目　番号
５　11111　　　　〇　　□　　　△　　　●　　■

最初のご回答をいただいただけでも満足しなければならないのは十二分に承知しております。ただ、もし可能ならばと欲がでてしまいました。
本当に申し訳ありません。
今ひとたびのご教示の程、よろしくお願い申し上げます。