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

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

目次

構成
メールシートのVBAコード
UserForm1のコード
ポイント解説
応用アイデア

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上で実現できます。
ぜひ業務効率化の参考にしてください！ 🚀