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

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

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

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

Public Function fncGetZip(住所 As String, CSVFaliPath As StringAs String
'*******************************************************************************
'住所から郵便番号を取得する Address-Zip
'*******************************************************************************
'引数:住所=郵便番号を探す住所
'引数: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
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)

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

If 決定 = "" Then
    With CSVシート
        c = .Range("a65536").End(xlUp).Row
        決定 = ""
            For d = 1 To c
                連住所 = .Cells(d, 8).Value & "大字" & .Cells(d, 9).Value
                    If InStr(1, 住所, 連住所) <> 0 Then
                        決定 = .Cells(d, 3).Value
                        Exit For
                    End If
            Next d
    End With
End If

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

'35YAMAGU
End Function






Production Japan Import Application. Since 1998