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

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][特殊・他 郵便番号から住所を取得する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






Production Japan Import Application. Since 1998