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

質問

講習会の受講者名簿を作成しています。（名簿は科目別で３つのシートに分かれています。）
現在下記モジュールで、受講者名・受講者番号を個々に入力し検索出来るようにしていますが、
受講日（例：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.1

keithin · ベストアンサー

「検索＆抽出」シートの６行目に（ご質問で掲示されているマクロとは違って）集計表のタイトル行が記入済みとします。

sub macro1()
　dim k as integer, c as integer
　dim ws as worksheet
　dim flg as boolean
　dim s as date
　dim e as date

　set ws = worksheets("検索＆抽出")
　if application.counta(ws.range("B1:B4")) = 0 then
　　msgbox "SET CONDITION"
　　exit sub
　end if

　if application.count(ws.range("B3:B4")) = 1 then
　　msgbox "SET FROM TO"
　　exit sub
　else
　　flg = true
　　s = iif(isdate(ws.range("B3").value), ws.range("B3").value, 1)
　　e = iif(isdate(ws.range("B4").value), ws.range("B4").value, 99999)
　end if

　ws.rows("7:" & application.max(ws.range("A65536").end(xlup).row, 7)).clearcontents

　for k = 2 to 4
　with worksheets(k)
　　if ws.range("B1") <> "" then
　　　.range("A1:N1").autofilter field:=2, criteria1:=ws.range("B1")
　　end if

　　if ws.range("B2") <> "" then
　　　.range("A1:N1").autofilter field:=3, criteria1:=ws.range("B2")
　　end if

　　if flg then
　　　.range("I1:N1").unmerge
　　　for c = 9 to 14
　　　　.range("A1:N1").autofilter field:=c, criteria1:=">=" & s, operator:=xland, criteria2:="<=" & e
　　　　.autofilter.range.offset(1).copy ws.range("A65536").end(xlup).offset(1)
　　　　.range("A1:N1").autofilter field:=c
　　　next c
　　　.range("I1:N1").merge
　　else
　　　　.autofilter.range.offset(1).copy ws.range("A65536").end(xlup).offset(1)
　　end if
　　.autofiltermode = false
　end with
　next k
end sub

補足

回答ありがとうございます！！
「検索＆抽出」シートの６行目に集計表のタイトル行が記入済みでしたので、
ご教示いただいたもので検索してみたところ、期間での検索結果は出たのですが氏名と登録番号の検索結果が抽出されなくなってしまいました。
その場合、どのように訂正したら良いでしょうか？
宜しくお願いします。