特殊・他 郵便番号から住所を取得するZip-Address
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Public Function fncGetAddress(郵便番号 As String, CSVFaliPath As String) As String '******************************************************************************* '郵便番号から住所を取得する Zip-Address '******************************************************************************* '引数：郵便番号＝住所を探す郵便番号 '引数：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, 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.７桁か？ If Len(e(3)) <> 7 Then 決定 = "" MsgBox "郵便番号形式が７桁ではありません。", 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 |