【Access】 郵便番号を検索するシステム

質問

よろしくお願いいたします。

現在、Accessのフォームにて、任意の番号をテキストボックス("(1)")に入力し"検索ボタン"を押すと、該当する郵便番号がフォーム上のテキストボックス("(2)")に表示されるシステムを作っています。
また、郵便番号は"郵便番号一覧"というテーブルにまとめています。
(テーブルには約14万件の"郵便番号"と"住所"が含まれています)

ここで質問があるのですが、同じ郵便番号であっても複数の住所が該当するケースがあります。
テーブルにもそうした件が多数含まれていますが、現在の私のVBAでは、その内のひとつの住所しか表示することが出来ません。
そこで、複数の住所が存在する場合は、該当する住所の一覧が表示され、その中から1件を選べるようなシステムを作りたく考えています。

様々な参考書を読み続けてきましたが、完全に行き詰まりました。お知恵を拝借頂けますと幸いです。

--------------------------------

尚、現在のVBAは下記の通りです。

Private Sub 検索ボタン_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("郵便番号一覧", dbOpenTable)
With rs
.Index = "郵便番号"
.Seek "=", Me.(1)
End With
If Not rs.NoMatch Then
With Me
.(2) = rs!住所
End With
End If
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub

回答No.1

noname#60992 · ベストアンサー

私だったら
郵便番号による抽出クエリをひとつ作り
抽出結果が２以上だったら、いったんリストボックスにデータをいれて
リストをダブルクリックするか何かのイベントでテキストボックスにデータをコピーする
というようなことをします。
リストボックスが邪魔なら、必要なときだけ表示させます。

DAO でも
>If Not rs.NoMatch Then
の部分を

Do Until rs.NoMatch
　　ｒｓ.Seek "=", Me.(1)
　　...................
Loop

とすれば連続して検索できます。

お礼

ありがとうございました。
リストボックスを作成する方法に切り替えて再度チャレンジしてみます。

回答No.4

noname#22222

s_husky です。

細かいフィールドのタイプによって表示形式に変換している部分は Access 用に変更する必要があります。

回答No.3

noname#22222

まあ、僅か一行でも書けるかと・・・。

Private Sub コマンド_検索_Click()
　　Me.リスト_住所検索結果.RowSource = DBSelect("A, B, C", "Table1", , "ID=1", , True, False)
End Sub

もちろん、次のような DBSelect関数を使えばです。

＊上述のコードはテスト済みです。
＊リストボックスの値集合タイプ=リストです。

' -------------------------------------------------------------------------------------------------------
'　DBSelect(列リスト,
'　　　　　 表名,
'　　　　　 グループ指定文,
'　　　　　 条件文,
'　　　　　 並び替え文,
'　　　　　 isOneSentence, ---- 列データをセミコロン(;)で連結して１文にするか否か？
'　　　　　 isConvert) -------- 列データを表示形式に変換してから配列に代入するか否か？
' -------------------------------------------------------------------------------------------------------
Public Function DBSelect(ByVal strFields As String, _
　　　　　　　　　　　　 ByVal strTable As String, _
　　　　　　　　　　　　 Optional strGroupBy As String, _
　　　　　　　　　　　　 Optional strWhere As String, _
　　　　　　　　　　　　 Optional strOrderBy As String, _
　　　　　　　　　　　　 Optional isOneSentence As Boolean = False, _
　　　　　　　　　　　　 Optional isConvert As Boolean = False) As Variant
On Error GoTo Err_DBSelect
　　Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim R　　　　　 As Integer　　' データを代入する配列 DataValue(,) のインデックスを決める行カウンター
　　Dim C　　　　　 As Integer　　' データを代入する配列 DataValue(,) のインデックスを決める列カウンター
　　Dim M　　　　　 As Integer　　' データを代入する配列 DataValue(,) の一つ目の添字の最大値=行総数 - 1
　　Dim N　　　　　 As Integer　　' データを代入する配列 DataValue(,) の二つ目の添字の最大値=列総数 - 1
　　Dim strQuerySQL As String
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　　 ' 全てのデータをセミコロン(;)で区切った１行の文字列を格納する変数

　　Set rst = New ADODB.Recordset

　　strQuerySQL = "SELECT " & strFields & " FROM " & strTable
　　If Len(strGroupBy) > 0 Then
　　　　strQuerySQL = strQuerySQL & " GROUP BY " & strGroupBy
　　End If
　　If Len(strWhere) > 0 Then
　　　　strQuerySQL = strQuerySQL & " WHERE " & strWhere
　　End If
　　If Len(strOrderBy) > 0 Then
　　　　strQuerySQL = strQuerySQL & " ORDER BY " & strOrderBy
　　End If
　　' =================
　　'　Begin With: rst
　　' -----------------
　　With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 CurrentProject.Connection, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　' --------------
　　　　　　'　配列を再宣言
　　　　　　' --------------
　　　　　　M = .RecordCount - 1
　　　　　　N = .Fields.Count - 1
　　　　　　If M > 99 Then
　　　　　　　　MsgBox "読込む行総数を100行に下方修正しました。(DBSelect)", vbInformation, " お知らせ"
　　　　　　　　M = 99
　　　　　　End If
　　　　　　ReDim DataValues(M, N)
　　　　　　' ------------------------------------
　　　　　　'　列情報を For-Next で配列に代入する
　　　　　　' ------------------------------------
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　C = -1
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　' =================
　　　　　　　　　　'　Begin With: fld
　　　　　　　　　　' -----------------
　　　　　　　　　　With fld
　　　　　　　　　　　　C = C + 1
　　　　　　　　　　　　If Not isConvert Then
　　　　　　　　　　　　　　DataValues(R, C) = Nz(.Value, "")
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　' --------------------------
　　　　　　　　　　　　　　'　列データを表示形式に変換
　　　　　　　　　　　　　　' -------------------------
　　　　　　　　　　　　　　Select Case .Type
　　　　　　　　　　　　　　　　Case adBoolean　　　　　　　　　' ブール型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = IIf(.Value = -1, "Yes", "No")
　　　　　　　　　　　　　　　　Case adChar, adVarChar　　　　　' 文字列型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = Nz(.Value, "")
　　　　　　　　　　　　　　　　Case adDBDate, adDBTimeStamp　　' 日付型(yyyymmdd)、日付/時刻型(yyyymmddhhmmss + 1/10億)
　　　　　　　　　　　　　　　　　　DataValues(R, C) = .Value
　　　　　　　　　　　　　　　　Case adSmallInt, adInteger　　　' 整数
　　　　　　　　　　　　　　　　　　DataValues(R, C) = FormatNumber(.Value, 0)
　　　　　　　　　　　　　　　　Case adSingle, adDouble　　　　 ' 浮動小数点型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = FormatNumber(.Value, 2)
　　　　　　　　　　　　　　　　Case adCurrency　　　　　　　　 ' 通貨型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = FormatCurrency(.Value, 2)
　　　　　　　　　　　　　　　　Case Else
　　　　　　　　　　　　　　　　　　DataValues(R, C) = .Value
　　　　　　　　　　　　　　End Select
　　　　　　　　　　　　End If
　　　　　　　　　　End With
　　　　　　　　　　' ---------------
　　　　　　　　　　'　End With: fld
　　　　　　　　　　' ===============
　　　　　　　　Next fld
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　 Else
　　　　　　ReDim DataValues(0, 0)
　　　　　　DataValues(0, 0) = ""
　　　　　　strList = ""
　　　　 End If
　　End With
　　' ---------------
　　'　End With: rst
　　' ===============
　　If isOneSentence Then
　　　　' -------------------------------
　　　　'　セミコロン(;)で連結して１文に
　　　　' -------------------------------
　　　　For I = 0 To M
　　　　　　For J = 0 To N
　　　　　　　　strList = strList & DataValues(I, J) & ";"
　　　　　　Next J
　　　　Next I
　　End If
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(isOneSentence, strList, DataValues())
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

参考URL：

　

回答No.2

tkun62

自分が作るとしたら
１．番号入力
２．検索ボタン押下
３．リストボックスに候補を表示
４．リスト中の住所を選択
５．選択完了ボタン押下
といった感じの流れで作りますね。
３は連結しておけば良いし。
ＶＡＢも楽になるのでは？

繰り返しが分からないのであれば自分はよく
下記のような感じで行っています。
=====================================================
wSql = "SELECT * from 出荷 where 区分 = 1"
Set rs = db.OpenRecordset(wSql, dbOpenSnapshot, dbForwardOnly)
Do While Not rs.EOF
'処理・・・

rs.MoveNext
Loop
rs.Close
Set rs = Nothing

お礼

ありがとうございました。
リストボックスを作成する方法に切り替えて再度チャレンジしてみます。