Exceldで、二つのコンボボックスの選択した項目の検索、抽出転記するVBAコードをご教授願います

Exceldで、二つあるコンボボックスの選択した項目の検索、抽出、転記するVBAコードをご教授願います。

＜詳細＞
現在、請求先コンボボックスのデーターで、一つの項目の検索抽出転記は何とかできたのですが、コンボボックスで選んだ
データーの検索抽出転記できません。更に月度別のコンボボックスの月度合わせた検索抽出転記の、VBAコードを
どのように書いたら良いのか分からず困っています。



・検索シート = Sheets("印刷済") '検索　シート
　　　　　　　　　データーは増減します。

・転記先シート = Sheets("月請求書データー") '貼付先シート

・検索条件①コンボボックス1の入力データー
　　　　　　検索場所Sheets("印刷済")の（C列） '検索
　　　　　※現在は、4件だが増減します。

　　　　　②コンボボックス２の入力データー
　　　　　　検索場所Sheets("印刷済")の（B列） '検索
　　　　　　日付データー（2020/2/29）となっており月度で検索したい。
　　　　　※１～１２まで登録。
　　　　　　１は１月度（1月度＝2020/1/1～2020/1/31）の意味です。
　　 ２は2月度（2月度＝2020/2/1～2020/2/29）
・検索ボタンは、CommandButton1　です。　　　　　

　　上記二つの条件をコンボボックスで、選択して検索抽出、 Sheets("月請求書データー")へ
　　転記したい。
　　例えば、コンボボックス1の入力データー"A"を選択、コンボボック2の入力データー"1"(1月度＝2020/1/1～2020/1/31）を選択して、２つの条件を検索抽出し転記する流れです。、

＜添付画像から＞
・添付画像は、印刷済シートに内容です。
コンボボックスを表示しています。



説明がうまくありませんが、お分かりになる方、ご教授のほどよろしくお願いします。

下記は、1つの項目（Aのみ）の検索、抽出、転記です。

Private Sub CommandButton1_Click()

Worksheets("月請求書データー").Range("A1:K1000").ClearContents'転記前にsheetクリア

Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range
Dim myStr, ra, rr

If myStr = "*" Then

Exit Sub

End If

Set ws1 = Sheets("印刷済") '検索　シート

Set ws2 = Sheets("月請求書データー") '貼付先シート

With ws1.Columns("C") '検索（C列）

Set rng = .Find(What:="A", Lookat:=xlWhole, After:=.Cells(.Cells.Count)) '完全一致


If rng Is Nothing Then 'なかったら

MsgBox "ありません", vbCritical, myStr & "？"

Else 'あったら
ra = rng.Address '最初に見つかったセルアドレス

Do
rr = rr + 1 'カウント
rng.EntireRow.Copy Destination:=ws2.Cells(rr, 1) '行のコピペ
Set rng = .FindNext(rng) '連続検索
Loop While rng.Address <> ra '繰り返し
Set rng = Nothing
End If
End With


End Sub

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

• すみません
  追記です。
  日付の検索は、B列です。

    補足日時：2020/03/09 07:19

No.5 ベストアンサー 回答者： ママチャリ 回答日時： 2020/03/10 22:01

naまろんさんが分からないところって、・・・

Set rng = .Find(What:="A",～
・・・の固定で”A"を指定しているところをコンボボックスの値にしたいということでしょうか？
であれば、こんな感じです。
Set rng = .Find(What:=ComboBox1.Value,

次に月度別の抽出ですが、・・・
行をコピペするループを次のようにしてみましょう。

Do
If Month(rng.Offset(, -1).Value) = CInt(ComboBox2.Value) Then
rr = rr + 1 'カウント
rng.EntireRow.Copy Destination:=ws2.Cells(rr, 1) '行のコピペ
End If
Set rng = .FindNext(rng) '連続検索
Loop While rng.Address <> ra '繰り返し

ただし、月でしか判別していないので、今年だろうが去年だろうが、月が一致していたら抽出されてしまいます。この辺はお好みで修正してみてください。

この回答へのお礼

ありがとうございます。
ご教授頂いた内容で、OKでした。
対応して頂いたことに感謝しております。
誠に、ありがとうございました。

お礼日時：2020/03/11 07:54

No.4 回答者： めぐみん_ 回答日時： 2020/03/10 12:54

If Format(Range("B2").Value, "yyyy/m") = Year(Date) & "/" & ComboBox2.Value Then

セルはＢ２に固定してますけど、Combobox１でヒットした行のＢ列のセルを指定すれば可能かもしれないよ？

この回答へのお礼

取り入れてみますね。
いつも対応して頂きありがとうございます。
本当に、感謝しております。

お礼日時：2020/03/11 07:50

No.3 回答者： めぐみん_ 回答日時： 2020/03/10 10:08

考えてみたら何も期間にこだわる必要はないですよね

双方『年月』を取り出して比較すれば良いだけだし

この回答へのお礼

いろいろと教えていただき
ありがとうございます。

お礼日時：2020/03/11 07:48

No.2 回答者： めぐみん_ 回答日時： 2020/03/09 22:03

月度って『同年』で宜しいんでしょうかね？

Dim D_s As Date, D_e As Date
Dim i As Integer

For i = 1 To 12

D_s = DateSerial(Year(Date), i, 1)
D_e = DateAdd("d", -1, DateAdd("m", 1, D_s))

Debug.Print i & "月度 : " & D_s & "～" & D_e

Next

結果：

1月度 : 2020/01/01～2020/01/31
2月度 : 2020/02/01～2020/02/29
3月度 : 2020/03/01～2020/03/31
4月度 : 2020/04/01～2020/04/30
5月度 : 2020/05/01～2020/05/31
6月度 : 2020/06/01～2020/06/30
7月度 : 2020/07/01～2020/07/31
8月度 : 2020/08/01～2020/08/31
9月度 : 2020/09/01～2020/09/30
10月度 : 2020/10/01～2020/10/31
11月度 : 2020/11/01～2020/11/30
12月度 : 2020/12/01～2020/12/31

このような感じで。
For の i の代わりに Combobox の値を与えれば良いのかなと。

この回答へのお礼

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

お礼日時：2020/03/11 07:47

No.1 回答者： めぐみん_ 回答日時： 2020/03/09 11:18

個人的にはFindメソッドより、

Excel(エクセル) VBA入門：フィルタオプション(AdvancedFilter)でのデータ抽出
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …

を用いた方が昔は楽でしたね。
抽出条件の『項目』と『条件』を表の範囲外又は別シートに作成し、『項目』に合わせた『条件』のセルに値を代入して抽出されるデータを他に吐き出すって感じで。

でも今は他の方法があったような回答も見かけましたね。
私自身Excel２００２から一気に３６５まで最近飛びましたので、その間に追加されたのかなって思いますが不明です。（チラッと見ただけですので）

この回答へのお礼

いつもアドバイスありがとうございます。

お礼日時：2020/03/11 07:46