0

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

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

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

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

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

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

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

テーブルイメージ

1
  • 1
    質問は「作りたいもの」ではなく、作りたいものを実現するにあたって「何に躓いている/困っているか」という視点で書いてみてください。 / 現状の内容だとどの部分で困っているのかわからない、範囲が広すぎて回答が付きづらい印象です。
    – cubick
    Commented 2021年2月4日 16:40

1 件の回答 1

1

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

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

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

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

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

2
  • そっかぁ。。なんか残念だな。。。 Commented 2021年2月5日 10:51
  • Excelのスキルはそのまま使えませんが、データベースとSQLのスキルを取得したら、エクセルより効率的な開発ができて、データ量が多くても軽々と処理できます。苦労しただけの見返りは得られると思いますよ。
    – hatena
    Commented 2021年2月15日 14:57

この質問に回答するには、ログインする必要があります。

求めていた回答ではありませんか? のタグが付いた他の質問を参照する。