Microsoft Access 掲示板

Microsoft Access 掲示板

access　VBA　抽出

5 コメント
views
4 フォロー

フォーム画面に、日付・A・Ｂ・Ｃ・Ｄ・Ｅの計６個のフィールドがあります。
日付には、yyyy/mm/ddで入力された日付
A~Eには、各フィールドにtext入力された文字
これらのフィールドから、抽出する為に以下の様なテキストボックスを作っています。
・開始(text_box)　～　終了(text_box)　　・・・・任意の日付をyyyy/mm/ddでそれぞれ入力
・キーワード(text_box)・・・・・・・・・・・・・・任意の文字を入力
上記２つを入力し、同フォーム内に設置した抽出ボタンを押す事で、入力された期間内でかつA~E内フィールドに含まれるレコードを同じフォーム内に表示させたいです。（あいまい検索）
現状のVBAでは、期間内でA~Eの全てのフィールドにキーワードを含むレコードしか表示できず、やり方が分かりません。
A~E各フィールドの何れかに、含まれるレコードを抽出したいです。
例えば
　日付　　　 Ａ   　Ｂ  　 Ｃ   　 Ｄ   　Ｅ
2023/1/1　　あ　　い　 　う　　え　　お
2023/1/1　　か　　き　　 く　　け　　お
2023/1/2　　さ　　し　　 う　　せ　　そ
2023/1/3　　た　　ち　　 つ　　え　　と
2023/1/4　　あ　　か　　 さ　　え　　ご

開始：2023/1/1　～　終了：2023/1/3　　キーワード：う　　　抽出ボタンを押す
結果として以下を同フォームに表示
2023/1/1　　あ　　い　 　う　　え　　お
2023/1/2　　さ　　し　　 う　　せ　　そ

このような抽出は可能でしょうか。
最近始めたばかりで、説明も上手く出来ておりませんが
教えて頂きたいです。よろしくお願いいたします。

メイクーン
作成: 2023/06/04 (日) 21:25:32
通報 ...
1
hatena 2023/06/05 (月) 11:12:35

ヒントを出しておくと、A・Ｂ・Ｃ・Ｄ・Ｅの各フィールドの条件をOr演算子で連結すればいいでしょう。
あるいは、A・Ｂ・Ｃ・Ｄ・Ｅの各フィールド値を&演算子で結合してそれに対してLike演算子であいまい条件を設定すればいいでしょう。

上記のヒントで具体的にコードが分からない場合は、

現状のVBAでは、期間内でA~Eの全てのフィールドにキーワードを含むレコードしか表示できず、やり方が分かりません。

現状のVBAを提示してください。
2
メイクーン 2023/06/07 (水) 21:11:39

大変遅くなり申し訳ございません。
現状のVBAは以下になります。
【UP1】
Private Sub 抽出ボタン_Click()
Dim filter As String
    filter = ""
If Me!開始 <> "" And Me!終了 <> "" Then
    If Me!開始 > Me!終了 Then
        MsgBox "期間指定が不適切です。再入力してください。", vbCritical + vbOKOnly, "期間指定不備"
        Exit Sub
    End If
End If
If Me!開始 <> "" Then
       If Me!開始 <> "" Then
        filter = "日付 >= #" & Me!開始 & "# and 日付 <= #" & Me!終了 & "#"
    Else      
        filter = "日付 >= #" & Me!開始 & "#"      
    End If      
ElseIf Me!終了 <> "" Then
    filter = "日付 <= #" & Me!終了 & "#"     
End If

行の関係上、続きは別途UPします。
3
メイクーン 2023/06/07 (水) 21:14:15

【UP1の続き】
If Me!キーワード <> "" Then   
    If filter = "" Then
        filter = "A like '" & Me!キーワード & "'"
    Else
        filter = filter & " and A like '" & Me!キーワード & "'"  
    End If
End If
    If Me!キーワード <> "" Then
        If filter = "" Then
            filter = "B like '" & Me!キーワード & "'"
    Else
        filter = filter & " and B like '" & Me!キーワード & "'"          
    End If     
End If
If Me!C = True Then   
    If filter = "" Then
            filter = "C like '" & Me!キーワード & "'"
    Else
        filter = filter & " and C like '" & Me!キーワード & "'"
    End If
End If
If filter = "" Then
    Me.FilterOn = False
Else
    Debug.Print filter
    Me.filter = filter
    Me.FilterOn = True
    Me.OrderBy = "対応日 ASC"
    Me.OrderByOn = True
End If
End Sub

フィールドをABCの3つにしていますが実際は5つになります。宜しくお願い致します。
4
hatena 2023/06/07 (水) 22:51:49

下記でどうでしょう。

Private Sub 抽出ボタン_Click()
    Dim sFilter As String
    
    '日付入力値チェック
    If Not IsNull(Me!開始) And Not IsDate(Me!開始) Then
        Me!開始.SetFocus
        MsgBox "正しい日付を入力してください。", vbCritical + vbOKOnly, "日付入力不備"
        Exit Sub
    End If
    If Not IsNull(Me!終了) And Not IsDate(Me!終了) Then
        Me!終了.SetFocus
        MsgBox "正しい日付を入力してください。", vbCritical + vbOKOnly, "日付入力不備"
        Exit Sub
    End If
    '期間指定チェック
    If IsDate(Me!開始) And IsDate(Me!終了) Then
        If Me!開始 > Me!終了 Then
            MsgBox "期間指定が不適切です。再入力してください。", vbCritical + vbOKOnly, "期間指定不備"
            Exit Sub
        End If
    End If
    
    '抽出条件式生成
    If IsDate(Me!開始) Then
        sFilter = " AND 日付 >= #" & Me!開始 & "#"
    End If
    If IsDate(Me!終了) Then
        sFilter = sFilter & " AND 日付 <= #" & Me!終了 & "#"
    End If
    If Me!キーワード <> "" Then
        sFilter = sFilter & " AND [A] & ';' & [B] & ';' & [C] Like '*" & Me!キーワード & "*'"
    End If
    sFilter = Mid(sFilter, 6) '先頭の" AND "を削除
    
    If sFilter = "" Then
        Me.FilterOn = False
    Else
        Me.filter = sFilter
        Me.FilterOn = True
    End If
End Sub

A, B, Cの各フィールドに対して部分一致(あいまい検索)になってます。
例えば、Aフィールド 「あいう」、キーワード「う」でも一致とみなします。

もし、各フィールドに対して完全一致の条件にしたいなら、キーワードの条件式のコードを下記に修正してください。

        sFilter = sFilter & " AND ';' & [A] & ';' & [B] & ';' & [C] & ";" Like '*;" & Me!キーワード & ";*'"

フィールドの区切り記号として';'(セミコロン)を使用してますが、フィールド値にセミコロンが含まれる可能性がある場合は、含まれる可能性がない文字にしてください。
5
メイクーン 2023/06/10 (土) 21:54:45

本日教えて頂いたコードで上手く出来ました。
ありがとうございました。