VBAで複数列からの条件指定でデータを抽出したい

質問

講習会の受講者名簿を作成しています。（名簿は科目別で３つのシートに分かれています。）
現在下記モジュールで、受講者名・受講者番号を検索出来るようにしていますが、
別シートに次回受講日（例：2014/4/1～2014/4/31）で受講者を抽出できるようにしたいと考えています。
しかし、受講予定日は過去のものも含め複数列（I列～N列）まであります。
このような場合、どのようにしたら受講日で検索が可能になるでしょうか？
宜しくお願いします。

Sub Sample2()
Dim k As Long, endRow As Long, wS As Worksheet
Set wS = Worksheets("検索＆抽出")

If wS.Range("B1") = "" And wS.Range("B2") = "" Then
MsgBox "検索データを入力してください"
Exit Sub
End If
endRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 4 Then
wS.Rows(5 & ":" & endRow).ClearContents
End If
For k = 2 To 4
With Worksheets(k)
If wS.Range("B1") <> "" Then
.Range("A1").AutoFilter field:=2, Criteria1:=wS.Range("B1")
End If
If wS.Range("B2") <> "" Then
.Range("A2").AutoFilter field:=3, Criteria1:=wS.Range("B2")
End If
If .AutoFilter.FilterMode Then
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 2 Then
Range(.Cells(3, "A"), .Cells(endRow, "N")).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
.AutoFilterMode = False
End If
End With
Next k
End Sub

回答No.2

noname#203218 · ベストアンサー

VBA一例です。
フィルターは使用しない方法としました。

抽出元の検索開始セル、抽出先セル番地はコードから判断してますので間違っていたら修正下さい。

検索元のセル範囲と検索先のセル範囲は同じとしています。予定日の配置も同じで検索範囲以外の日を除外するだけなので空白セルが発生します。空白を詰める事は簡単ですので修正下さい。

抽出先は検索＆抽出のセルA5からとしています。
検索元はA3セルから検索開始としています。
データ抽出は値だけコピーと同じ結果になります。書式は含んでいません。

書式もコピーしたいのでしたら
.Copy Destinationを使用するとコピーも早いのでこちらを利用したら良いでしょう。
'A1～H10の範囲を、C1～C10の範囲へコピーします。
Range("A1:H10").Copy Destination:=Range("C1:C10")

Sub test()
Dim k As Long, endRow As Long, wS As Worksheet
Dim m, n, p As Long
Dim flag As Single
Dim sday, fday As Date

Set wS = Worksheets("検索＆抽出")

If Application.WorksheetFunction.CountA(wS.Range("B1:B4")) < 4 Then
MsgBox "検索データを入力してください"
Exit Sub
End If

endRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
sday = Range("B3")
fday = Range("B4")

If endRow > 4 Then
wS.Rows(5 & ":" & endRow).ClearContents
End If

m = 5

For k = 2 To 4
With Worksheets(k)

endRow = .Cells(Rows.Count, "A").End(xlUp).Row

n = 3

Do Until n > endRow

flag = 0

If .Cells(n, 1) = wS.Range("B1") And .Cells(n, 2) = wS.Range("B2") Then

For p = 9 To 14
If .Cells(n, p).Value >= sday And .Cells(n, p).Value <= fday Then
flag = 1
wS.Cells(m, p).Value = .Cells(n, p).Value
End If
Next

If flag = 1 Then
wS.Range("A" & m).Resize(, 8).Value = .Range("A" & n).Resize(, 8).Value
m = m + 1
End If

End If

n = n + 1

Loop

End With

Next

End Sub

お礼

ありがとうございました！！参考になりました！

補足

早速の回答ありがとうございます！！
ご教示いただいたＶＢＡですと、登録番号・氏名もすべて入力しないと検索ができませんでした。
日付の期間のみで検索する場合のＶＢＡを改めて教えていただけないでしょうか？
宜しくお願いします。

回答No.1

keithin

＞別シートに次回受講日（例：2014/4/1～2014/4/31）で受講者を抽出できるようにしたい

つまり、ご相談で掲示された「氏名or番号検索コピー」とは全く別に、新しいマクロを用意したいということですね。

＞過去のものも含め複数列（I列～N列）まであります。

今のマクロの応用で、シートごとに、Ｉ列からＮ列まで順繰り「１列ずつ」オートフィルタで絞ってはコピーしてくれば、ほとんど手を入れずに作成できます。

なお、今回のご相談内容は以下の点が不明なので具体的なサンプルマクロは割愛しますが、上述の方針でいけば多分ご自分で作成できると思います。

＞次回受講日（例：2014/4/1～2014/4/31）で受講者を抽出できるようにしたい

Ｉ列からＮ列に「具体的に」どういう内容で記載されているのか、そこから「次回受講日」に該当するか否かどういう判断をするのか、情報がありません。

またふつーに考えると「2014/4/13という受講日を検索する」のような事に思えますが、次回受講日が「４月１日～３０日」の区間になってるのはどういう事なのかもイミフメイです。
ある一日を検索するんじゃなく、４月１日から３０日までの区間に該当する受講日を検索したいのか、人によっては４月３日と４月１７日がそれぞれＪ列とＫ列に記載されているみたいなことがあるのか無いのか、それともＩ～Ｎ列のどこかに「2014/4/1～2014/4/31」と記入されているのを検索したいのか、という事ですね。

お礼

ありがとうございました！！参考になりました！

補足

回答ありがとうございます。
人によって、受講日が入力されている列がまちまちのためI列～N列という複数列になり、
おっしゃられていたとおり、４月１日から３０日までの区間に該当する受講日を抽出したいとかんがえております。
検索＆抽出のシートを補足で添付します。
宜しくお願い致します。