(AdvancedFilter) フィルターオプションのOR条件で抽出するには?

Question 104.9 Excel VBA Borad (掲示板)より Previous Next
出張データを入力し,スケジュール管理をするVBAを組んでいます。 下図のとおり、
ワークシート A列に出張用務名
B列に月日1
C列に月日1の開催時間帯
D列に月日1の開催場所
E列に月日2
F列に月日2の開催時間帯
G列に月日2の開催場所
を入力します。 同じ出張で2回に渡って開催される時(例えば7/15と8/1)に月日1と月日2を利用します。

このデータ範囲から例えば今週の出張データを抽出する場合,どうすればいいでしょうか?
H1とI1に「月日1」(検索範囲内の列と同じタイトル)、H2に「>=7/8」,I2に「<7/15」
J1とK1に「月日2」(検索範囲内の列と同じタイトル)、J2に「>=7/8」,K2に「<7/15」 と入力し、
H1:K2を抽出条件にAdvancedFilterを実行すると、該当データがあってもヒットしません。
月日1と月日2がAnd条件になるからでしょうか?
Answer   Copyright (C) 2012.7.5 永井善王
抽出前キー おっしゃるとおり 『月日1と月日2がAnd条件になるから』 ですね。
OR条件にしたいのなら、右図のように指定します。

もう少しですね。ガンバ! うまくできたらコードをアップしてください。
ありがとうございました
ご指導ありがとうございます。おかげ様で、できました。
抽出条件設定の行をズラすのですね。 目から鱗でした。 コードは以下のとおりです。
Dim H抽出初 As String
Dim H抽出終 As String
Dim H抽出条件 As String
Dim H最終行 As Integer

Private Sub cmb抽出_Click()
'抽出条件設定場所のクリア
    Range("H2:K3").Value = ""
    
    'エラーチェック
    If TB抽出初 <> "" And TB抽出終 <> "" Then
        H抽出初 = TB抽出初.Value
        If IsDate(H抽出初) = False Then
            MsgBox "抽出初めに日付データを入力して下さい", vbExclamation
            TB抽出初.Value = ""
            TB抽出初.SetFocus
            Exit Sub
        End If
        H抽出終 = TB抽出終.Value
        If IsDate(H抽出終) = False Then
            MsgBox "抽出終わりに日付データを入力して下さい", vbExclamation
            TB抽終.Value = ""
            TB抽出終.SetFocus
            Exit Sub
        End If
        If H抽出初 > H抽出終 Then
            MsgBox "抽出初めの日が終わりより前の日です。訂正して下さい。", vbExclamation
            TB抽出初.Value = ""
            TB抽出初.SetFocus
        End If
    End If
    
    '抽出条件の設定
    H抽出終 = DateAdd("d", 1, H抽出終)
    Range("H2").Value = ">=" & H抽出初
    Range("J3").Value = ">=" & H抽出初
    Range("I2").Value = "<" & H抽出終
    Range("K3").Value = "<" & H抽出終
    H抽出条件 = "Sheet1!H1:K3"
    
    'データ範囲の設定
    If Range("A2") = "" Then
        MsgBox "データがありません", vbInformation
        Exit Sub
    End If
    Range("A2").Select
    Selection.CurrentRegion.Select
    H最終行 = Selection.Rows.Count
    Range("A1", Cells(H最終行, 7)).Select
    
    '抽出+結果をM1に貼り付け
    Selection.AdvancedFilter Action:=xlFilterCopy, criteriarange:= _
    Range(H抽出条件), copytorange:=Range("M1"), Unique:=False
End Sub

 

Excel VBA Macro