Excel VBAでメールアドレス入力を自動補完するサジェストフォームを作る

Excelで大量のメールアドレスを入力する作業、毎回コピー＆ペーストしたりリストから探すのは手間ですよね。

この記事では、VBAを使ってセル入力時に候補を表示するサジェストフォームを作る方法を紹介します。
メールアドレスは前方一致、名前は部分一致で候補表示されるので、入力の手間を大幅に減らせます。

目次

1. 構成
2. メールシートのVBAコード
3. UserForm1のコード
4. ポイント解説
5. 応用アイデア

---

1. 構成

• メールシート: 入力用セル（例: B2:K4）
• アドレス帳シート: A列にメールアドレス、B列に名前
• UserForm1: ListBox1 と CommandButton1を配置し、候補を表示

---

---

---

---

2. メールシートのVBAコード

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range("B2:K4")) Is Nothing Then Exit Sub

    If Len(Trim(Target.Value)) = 0 Then Exit Sub

    ' 入力文字とセルアドレスをUserFormに渡す
    UserForm1.ShowCandidates CStr(Target.Value), Target.Address
End Sub

---

3. UserForm1のコード

Option Explicit

Public Sub ShowCandidates(ByVal keyword As String, ByVal targetAddress As String)
    Dim wsAddr As Worksheet, rng As Range, cell As Range
    Dim k As String, dict As Object, email As String, nameStr As String, itm As Variant

    k = Trim(LCase(keyword))
    Me.ListBox1.Clear
    Me.Tag = targetAddress

    If Len(k) = 0 Then Exit Sub

    Set dict = CreateObject("Scripting.Dictionary")
    Set wsAddr = ThisWorkbook.Sheets("アドレス帳")
    Set rng = wsAddr.Range("A2", wsAddr.Cells(wsAddr.Rows.Count, "A").End(xlUp))

    For Each cell In rng
        If Len(cell.Value) = 0 Then GoTo NextRow
        email = CStr(cell.Value)
        nameStr = CStr(cell.Offset(0, 1).Value)

        ' メールアドレス: 前方一致
        If LCase(email) Like k & "*" Then
            If Not dict.Exists(email) Then dict.Add email, email
        End If

        ' 名前: 部分一致
        If Len(nameStr) > 0 Then
            If InStr(1, nameStr, keyword, vbTextCompare) > 0 Then
                If Not dict.Exists(email) Then dict.Add email, email
            End If
        End If
NextRow:
    Next cell

    If dict.Count = 0 Then
        Unload Me
        Exit Sub
    End If

    For Each itm In dict.Items
        Me.ListBox1.AddItem itm
    Next itm

    If Me.ListBox1.ListCount > 0 Then Me.ListBox1.ListIndex = 0
    Me.Show vbModeless
End Sub

Public Sub ApplySelection()
    If Me.ListBox1.ListIndex >= 0 Then
        Dim tgt As Range
        Set tgt = ThisWorkbook.Sheets("メール").Range(Me.Tag)
        Application.EnableEvents = False
        tgt.Value = Me.ListBox1.Value
        Application.EnableEvents = True
    End If
    Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ApplySelection
End Sub

Private Sub CommandButton1_Click()
    ApplySelection
End Sub

---

4. ポイント解説

• セル入力時にフォームを表示: Worksheet_Changeで入力を監視
• 検索方法: メールアドレスは前方一致、名前は部分一致
• 重複排除: Scripting.Dictionaryで候補を整理
• 操作性: vbModelessフォームで作業を中断せずに操作可能

---

5. 応用アイデア

• ListBoxに「名前 + メールアドレス」を表示して選択時にわかりやすくする
• 候補が1件だけなら自動入力
• 部署やグループごとに入力範囲や候補を拡張

---

Excelの標準機能だけでは面倒なメール入力も、VBAを使えばGmail風の補完機能をExcel上で実現できます。
ぜひ業務効率化の参考にしてください！ 🚀