🔧
ValidateEmailFormat
ユーティリティ選択範囲のメールアドレス形式を検証する
メールアドレスの形式をVBAで検証するマクロです。正規表現（RegExp）を使って「ユーザー名@ドメイン.TLD」の基本的な形式チェックを行い、不正なアドレスを含むセルをハイライトまたはリスト出力します。選択範囲内の全メールアドレスを一括検証し、有効・無効・空白の3種類に分類して集計することができます。顧客データのクレンジングやメール配信前の品質チェックに欠かせません。内部ではVBScript.RegExpオブジェクトに基本的なメールアドレスパターンを設定し、Testメソッドで真偽判定を行っています。ValidatePhoneNumberと同じ「入力データの品質検証」という目的を持つ姉妹マクロで、顧客データベースの登録前チェックとして両方を組み合わせて実行するのが一般的な運用です。目視でのチェックでは見逃しがちな微細な表記ミスも確実に検出できます。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： メールアドレスが入力されたセル範囲を選択して実行
🎯 活用シーン
- ✓顧客管理台帳のメールアドレス列を一括チェックして不正形式を特定
- ✓メール配信リスト送付前の最終品質チェックで無効アドレスを排除
- ✓入力フォームから取り込んだデータのメールアドレス妥当性を自動検証
- ✓メールマガジン配信リストの登録時に、明らかに誤った形式のアドレスをその場で弾きたいとき
- ✓CRMへの一括インポート前に、既存データに含まれる不正なメールアドレスを洗い出したいとき
💡 実装のヒント
- ▸RegExpのパターン "^[\w.+\-]+@[\w\-]+(\.[\w\-]+)+$" で基本チェックができます
- ▸TestメソッドでTrueなら有効形式、FalseならNG判定できます
- ▸厳密な検証はRFC 5322に準拠したより詳細な正規表現が必要です
- ▸簡易パターンでは一部の特殊な形式（プラス記号を含むエイリアス等）を誤って弾く場合があるため、実運用のデータに合わせてパターンを調整してください。
- ▸形式チェックだけでは実在するアドレスかは判定できないため、重要な用途では別途確認メール送信による検証も検討してください。
💻 VBAコード
' ValidateEmailFormat
' -----------------
' Macro Name: ValidateEmailFormat
' Description: 選択範囲のメールアドレス形式を検証する
' Parameters: なし
' Returns: なし
' Usage: メールアドレスが入力されたセル範囲を選択して実行
' -----------------
Sub ValidateEmailFormat()
Dim cell As Range
Dim validCount As Long
Dim invalidCount As Long
Dim outputRow As Long
Dim ws As Worksheet
Dim resultWs As Worksheet
Dim emailPattern As String
Dim i As Long
On Error GoTo ErrorHandler
If TypeName(Selection) <> "Range" Then
MsgBox "セル範囲を選択してください。", vbExclamation
Exit Sub
End If
emailPattern = "^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$"
validCount = 0
invalidCount = 0
Set resultWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
resultWs.Name = "メール検証_" & Format(Now, "hhnnss")
resultWs.Cells(1, 1).Value = "メール検証結果"
resultWs.Cells(1, 1).Font.Bold = True
resultWs.Cells(1, 1).Font.Size = 14
resultWs.Cells(3, 1).Value = "セル"
resultWs.Cells(3, 2).Value = "メールアドレス"
resultWs.Cells(3, 3).Value = "結果"
resultWs.Cells(3, 1).Font.Bold = True
resultWs.Cells(3, 2).Font.Bold = True
resultWs.Cells(3, 3).Font.Bold = True
resultWs.Range(resultWs.Cells(3, 1), resultWs.Cells(3, 3)).Interior.Color = RGB(200, 200, 200)
outputRow = 4
For Each cell In Selection
If cell.Value <> "" Then
Dim emailAddr As String
emailAddr = CStr(cell.Value)
If IsValidEmail(emailAddr, emailPattern) Then
resultWs.Cells(outputRow, 1).Value = cell.Address
resultWs.Cells(outputRow, 2).Value = emailAddr
resultWs.Cells(outputRow, 3).Value = "有効"
resultWs.Cells(outputRow, 3).Font.Color = RGB(0, 128, 0)
validCount = validCount + 1
Else
resultWs.Cells(outputRow, 1).Value = cell.Address
resultWs.Cells(outputRow, 2).Value = emailAddr
resultWs.Cells(outputRow, 3).Value = "無効"
resultWs.Cells(outputRow, 3).Font.Color = RGB(255, 0, 0)
resultWs.Cells(outputRow, 1).Interior.Color = RGB(255, 230, 230)
resultWs.Cells(outputRow, 2).Interior.Color = RGB(255, 230, 230)
resultWs.Cells(outputRow, 3).Interior.Color = RGB(255, 230, 230)
invalidCount = invalidCount + 1
End If
outputRow = outputRow + 1
End If
Next cell
resultWs.Cells(outputRow + 1, 1).Value = "合計: " & (validCount + invalidCount) & " 件"
resultWs.Cells(outputRow + 1, 2).Value = "有効: " & validCount & " / 無効: " & invalidCount
resultWs.Columns("A:C").AutoFit
resultWs.Select
MsgBox "検証完了: 有効 " & validCount & " 件、無効 " & invalidCount & " 件", vbInformation
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub
Private Function IsValidEmail(email As String, pattern As String) As Boolean
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = pattern
regEx.IgnoreCase = True
IsValidEmail = regEx.Test(email)
End Function