特殊・他 住所から郵便番号を取得するAddress-Zip
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Public Function fncGetZip(住所 As String, CSVFaliPath As String) As String '******************************************************************************* '住所から郵便番号を取得する Address-Zip '******************************************************************************* '引数：住所＝郵便番号を探す住所 '引数：CSVFaliPath＝ＣＳＶファイルのあるルートパス 'ＣＳＶファイルは '読み仮名データの促音・拗音を小書きで表記したもの（例：ホッカイドウ)を使用 '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 |