特殊・他 郵便番号から住所を取得するZip-Address

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Public Function fncGetAddress(郵便番号 As String, CSVFaliPath As StringAs String
'*******************************************************************************
'郵便番号から住所を取得する Zip-Address
'*******************************************************************************
'引数:郵便番号=住所を探す郵便番号
'引数:CSVFaliPath=CSVファイルのあるルートパス
'CSVファイルは
'読み仮名データの促音・拗音を小書きで表記したもの(例:ホッカイドウ)を使用
'http://www.post.japanpost.jp/zipcode/dl/kogaki.html
'より入手

Application.ScreenUpdating = False

Dim CSVファイル As Workbook, CSVシート As Worksheet
Dim a As String, b As String, c As Long, d As Long, e(5) As String, f As Byte
Dim 連住所 As String, 決定 As String
a = Dir(CSVFaliPath): b = Mid(a, 1, Len(a) - 4)
psbブックを開く CSVFaliPath
Set CSVファイル = Workbooks(a)
Set CSVシート = CSVファイル.Worksheets(b)

'郵便番号を必要形式に変える
'1.小文字変換
e(1) = StrConv(Trim(郵便番号), vbLowerCase)
e(3) = ""
    For f = 1 To Len(e(1))
        e(2) = Mid(e(1), f, 1)
            If IsNumeric(e(2)) = True Then
                e(3) = e(3) & e(2)
            End If
    Next f
'2.7桁か?
If Len(e(3)) <> 7 Then
決定 = ""
MsgBox "郵便番号形式が7桁ではありません。", vbCritical, "郵便番号形式エラー"
GoTo myend:
End If

With CSVシート
    c = .Range("a65536").End(xlUp).Row
    決定 = ""
        For d = 1 To c
            If e(3) = .Cells(d, 3).Value Then
                連住所 = .Cells(d, 7).Value & .Cells(d, 8).Value & .Cells(d, 9).Value
                決定 = 連住所
            End If
        Next d
End With

myend:
If 決定 = "" Then
MsgBox "指定ファイル内に指定郵便番号の住所は見つかりませんでした。", vbCritical, "住所検索"
fncGetAddress = 0
Else
fncGetAddress = 決定
End If
CSVファイル.Close
Set CSVファイル = Nothing
Set CSVシート = Nothing

'35YAMAGU
End Function

 

 

 

2000年01月01日|[VBサンプルコード]:[特殊・他]