　　素材>ExcelVBA

住所入力フォームなんかを作ってみる

今回はユーザーフォームを作ってみます。
例えばの話はがきの宛名面を作るのにユーザーフォームを出せば
いちいちセルを移動したりしなくてもいいってものデス。

でも･･･コードがあちこちに分散(標準モジュールとかユーザーフォーム)してるので･･･あうぅ･･･

とりあえずスクショ。

住所が岐阜県なのはまあ適当だ。鵜飼だ。鮎が喰いたい。

担当と季節は「季節によって担当の写真を変える」等に利用可能。

えーと、住所検索の前提として、「郵便番号のデータベース」が必要となります。
そんなん作るの大変ですよね？ね？根性で作るなんて馬鹿なの？って感じですよね。
でもね･･･あるんです･･･データベース。
郵便HPに行ってください、あるんです！
ただ、少々カスタムは必要ですけどね･･･
あと、郵便番号のデータベースは膨大なので全県全地名やると大変です。
･･･必要な県だけで作るのが無難かもしれません。
何で岐阜県なんだよ･･･

･･･とりあえず、コード(丸写し)です。

以下コード(module1)

Option Explicit
Sub 入力フォーム起動()
    登録フォーム.Show
End Sub
Sub 住所クリア()
    Range("A2:F2").Select
    Selection.ClearContents
    Range("A2").Select
End Sub

(ユーザーフォーム)

Option Explicit
Private kisetsu As String

Private Sub 夏_Change()
    If 夏.Value = True Then
        kisetsu = "夏"
    End If
End Sub
Private Sub 冬_Change()
    If 冬.Value = True Then
        kisetsu = "冬"
    End If
End Sub
Private Sub UserForm_Initialize()
    With 担当者名
        .AddItem "安藤"
        .AddItem "伊藤"
        .AddItem "宇藤"
        .AddItem "江藤"
        .AddItem "尾籐"
    End With
    夏.Value = True
End Sub
Private Sub 住所登録_Click()
    If 郵便番号 = "" Then
        MsgBox "郵便番号を入れてください"
        Exit Sub
    End If
    If 郵便番号2 = "" Then
        MsgBox "郵便番号を入れてください"
        Exit Sub
    End If
    If 住所 = "" Then
        MsgBox "住所を入れてください"
        Exit Sub
    End If
    If 宛名 = "" Then
        MsgBox "宛名を入れてください"
        Exit Sub
    End If
    If 担当者名 = "" Then
        MsgBox "担当者を入れてください"
        Exit Sub
    End If
    If kisetsu = "" Then
        MsgBox "季節を選択してください"
        Exit Sub
    End If
    
    With ActiveSheet
        .Range("A2").Value = 郵便番号.Text
        .Range("B2").Value = 郵便番号2.Text
        .Range("C2").Value = 住所.Text
        .Range("D2").Value = 宛名.Text
        .Range("E2").Value = 担当者名.Text
        .Range("F2").Value = kisetsu
    End With
    
    郵便番号.Text = ""
    郵便番号2.Text = ""
    住所.Text = ""
    宛名.Text = ""
    登録フォーム.Hide
End Sub

Private Sub 番号検索_Click()
    Dim 検索値 As String
    Dim 検索セル As Range
    検索値 = 郵便番号.Text & 郵便番号2.Text
      Application.ScreenUpdating = False
      Worksheets("住所検索用").Visible = True
      Worksheets("住所検索用").Select
    With Worksheets("住所検索用")
      Set 検索セル = .Range("A1:A3365").Find(検索値)
        If 検索セル Is Nothing Then
        MsgBox "その郵便番号は存在しません"
         Else
        住所.Text = Cells(検索セル.Row, 2)
        End If
    End With
      Worksheets("住所検索用").Visible = False
      Application.ScreenUpdating = True
End Sub

まずはユーザーフォームを作りましょうかね。

こんな感じで配置していきます。

とりあえずこんな感じでしょうか。
一応サンプルのExcelファイルも置いておきますので参考に･･･
(マクロが入っているため警告が出ますが自己責任でお願いします)

住所入力1行のみ版(はがきの宛名向け)
住所入力複数行対応版(住所録向け)