

ACCESS VBAで検索フォームを作成したいと考えています。  
（クエリ―でも同じようなことはできると思うのですが、今回はVBAで実装したいと考えています）

添付画像のように「各会員番号」と「各店舗」との距離が格納されている同一フォーマットのテーブルが約20ほどあります。（テーブルはチェーンごとに分割されている）

条件を指定することで、条件に合致する会員番号を抽出するような検索フォームを作成したいと考えており、  
例えば「チェーンAが距離50ｋｍ以内に2店舗以上あり、且つ(もしくは)チェーンBが30ｋｍ以内に1店舗以上ある会員」のようにand条件やor条件で複数条件を指定できるようにしたいです。

Excel VBAで途中まで実装していたのですが、データ量が多いためACCESSでの管理に移行したいと考えており、  
以下のコードを少し変更することでACCESSで検索フォームを作ることはできますでしょうか？

ACCESSをあまり使ったことが無く、詳しくないためお聞きしています。

[code]

    Sub test()
    Const fpath As String = "D:\Data\"
    Dim fName As String
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim cname As String
    Dim tb1() As Variant, tb2() As Variant
    Dim r1 As Long, r2 As Long, c As Long
    Dim i As Long, imax As Long
    Dim j As Long, jmax As Long
    Application.ScreenUpdating = False
    Set sh = Worksheets("Sheet1")
    With sh
    If .Range("F4").Value <> "" Then
    .Range("F4:F" & .Cells(Rows.Count, 6).End(xlUp).Row).ClearContents
    End If
    End With
    ReDim tb1(2, 0)
    fName = Dir(fpath & "*.xlsx", vbNormal)
    Do Until fName = ""
    Set wb = Workbooks.Open(fpath & fName)
    With wb.Worksheets(1)
    For r1 = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
    For c = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
    tb1(0, UBound(tb1, 2)) = .Cells(r1, 1).Value
    tb1(1, UBound(tb1, 2)) = Left(fName, Len(fName) - 5)
    tb1(2, UBound(tb1, 2)) = .Cells(r1, c).Value
    ReDim Preserve tb1(2, UBound(tb1, 2) + 1)
    Next c
    Next r1
    End With
    wb.Close
    fName = Dir()
    Loop
    imax = UBound(tb1, 2) - 1
    r2 = 3
    With sh
    For r1 = 4 To .Cells(Rows.Count, 2).End(xlUp).Row
    If .Cells(r1, 3).Value <> "未設定" And .Cells(r1, 4).Value <> 0 Then
    Erase tb2
    ReDim tb2(1, 0)
    For i = 0 To imax
    If tb1(1, i) = .Cells(r1, 2).Value And tb1(2, i) <= .Cells(r1, 3).Value Then
    For j = 0 To UBound(tb2, 2) - 1
    If tb1(0, i) = tb2(0, j) Then
    tb2(1, j) = tb2(1, j) + 1
    End If
    Next j
    If j > UBound(tb2, 2) - 1 Then
    tb2(0, UBound(tb2, 2)) = tb1(0, i)
    tb2(1, UBound(tb2, 2)) = 1
    ReDim Preserve tb2(1, UBound(tb2, 2) + 1)
    End If
    End If
    Next i
    jmax = UBound(tb2, 2) - 1
    For j = 0 To jmax
    If tb2(1, j) >= .Cells(r1, 4) Then
    r2 = r2 + 1
    Cells(r2, 6).Value = tb2(0, j)
    End If
    Next j
    End If
    Next r1
    '重複削除
    .Range("F4:F" & .Cells(Rows.Count, 6).End(xlUp).Row).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    End With
    Application.ScreenUpdating = True
    End Sub
    
[/code]

※こちらのコードはデータを横持ちで持つことを想定して実装していましたが、ACCESSでは縦持ちで保持したいと考えています。

[![テーブルイメージ](https://i.stack.imgur.com/6JRR2.png)](https://i.stack.imgur.com/6JRR2.png)


CC BY-SA 4.0
2021-02-04T12:20:25.420
73798
2021-02-05T01:20:54.960
42369
question
vba ms-access
ACCESSで検索フォームを作成したい


> 以下のコードを少し変更することでACCESSで検索フォームを作ることはできますでしょうか？

結論からいいます。できません。  
Excelは表計算ソフト、Accessはリレーショナルデータベースソフト、まったく別のものです。  
提示のコードはAccessで使える部分はまったくありません。  
Accessで設計する場合は、Excelでの経験はいったん捨ててください。

> ACCESS VBAで検索フォームを作成したいと考えています。  
>  （クエリ―でも同じようなことはできると思うのですが、今回はVBAで実装したいと考えています）

すでに最初から間違っています。データベースはSQLでデータ操作をします。検索(抽出)もです。クエリの中身はSQLです。クエリはSQLが分からない人でもビジュアル的にSQL設計できるツールです。  
そして、Accessのフォームは基本的にクエリと連結して使うものです。  
VBAを使う場合も、結局はSQLをVBAから操作することになります。

エクセルのことはいったん忘れ、まずは入門書でAccessの基本機能から学習すべきです。  
また、データベースはテーブル設計が重要です。エクセルのワークシートの感覚で設計するとデータベースとしては使い物にならないものになりがちです。データベースのテーブル設計の基本も学習する必要があります。


CC BY-SA 4.0
2021-02-05T01:20:54.960
73806
2021-02-05T01:20:54.960
42240
73798
answer