EXCEL VBA 氏名からメールアドレスを自動生成・名前情報からメールを作成・業務効率化（テクニック）

2023年3月26日

EXCEL VBA 氏名からメールアドレスを自動生成・名前情報からメールを作成・業務効率化（テクニック）

●はじめに

今回説明するのはExcelに登録されている氏名（カタカナ）データから名字と名前を抽出して、メールアドレスを作成するプログラムです。このプログラムを使う事で、効率的にメールアドレスを作成する事ができます。なお、新規従業員のメールアドレス生成: 新入社員や新たにプロジェクトに参加するメンバーのメールアドレスを一括で生成する際にとても役立ちます。それでは、詳細については順番に説明いたします。

【下記のコードを利用するメリット】

・時短効果: 名前からメールアドレスを自動生成することで、手作業でメールアドレスを作成する時間と労力を大幅に節約できます。
・一貫性: すべてのメールアドレスが同じ形式で生成されるため、企業や組織内でのメールアドレスの一貫性が保たれます。
・エラーの削減: 手作業でメールアドレスを作成する際に発生する可能性のある入力ミスや表記ゆれを減らすことができます。
・ヘボン式ローマ字変換: ひらがなやカタカナの名前をヘボン式ローマ字に変換する機能が組み込まれており、日本語の名前を英語表記に変換する際に便利です。※（正式なヘボン式とは一部異なります）

●【EXCEL VBA パスワードの自動作成については、下記を参照して下さい】

EXCEL VBA パスワードの自動生成・ランダムパスワードの生成（テクニック）

●プログラムの説明

●　このサンプルプログラムは、名前（カタカナ）をメールアドレスに変換する処理を行っています。名前は全角スペースで区切られた姓と名がC列に入力されており、それらの値をヘボン式ローマ字（一部異なる）に変換し、メールアドレスの形式にしてD列に出力します。【処理手順】

ワークシートの使用範囲内の行数だけループを実行する。
セルC列の値に全角スペースが含まれている場合、姓と名に分割する。
姓と名をヘボン式ローマ字に変換する。
姓と名が空でない場合、メールアドレスを作成する。
セルD列にメールアドレスを出力する。

【プログラム実行条件・注意事項】
・入力される名前は、全角スペースで区切られた姓と名である必要があります。
・ヘボン式ローマ字変換用の辞書は限定的であり、すべてのひらがな文字やカタカナ文字をカバーしていない場合があります。
※（オリジナルのため、正式なヘボン式とは一部異なります）
・名前が正確に変換されない場合があります。特に、辞書に登録されていない特殊なひらがなやカタカナ文字がある場合です。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　CreateEmails（サンプルプログラム）

Option Explicit

'
'
Sub createEmails()  'メールアドレスを生成
    Dim i As Integer
    Dim lastName As String
    Dim firstName As String
    Dim email As String
    
    ' ワークシートの使用範囲内の行数だけループする
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
        '変数を初期化する
        lastName = ""
        firstName = ""
        email = ""
        
        ' セルA列の値に全角スペースが含まれている場合
        If InStr(Range("C" & i).Value, "　") > 0 Then
            ' 姓と名に分割する
            lastName = Split(Range("C" & i).Value, "　")(0)
            firstName = Split(Range("C" & i).Value, "　")(1)
            
            ' 姓と名をヘボン式ローマ字に変換する
            lastName = kanaToHepburn(lastName)
            firstName = kanaToHepburn(firstName)
            
            ' 姓と名が空でない場合にメールアドレスを作成する
            If lastName <> "" And firstName <> "" Then
                email = firstName & "." & lastName & Range("G1")
            End If
        
        End If
        ' セルB列にメールアドレスを出力する
        Range("D" & i).Value = email
    
    Next i
End Sub
'
'

'
'
Function kanaToHepburn(ByVal kana As String) As String
    Dim hiragana As String
    Dim katakana As String
    Dim i As Long
    Dim romaji As String
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' カタカナをひらがなに変換する
    hiragana = StrConv(kana, vbHiragana)
    
    ' 全角スペースを半角スペースに変換する
    hiragana = Replace(hiragana, "　", " ")
    
    ' ヘボン式ローマ字に変換する（辞書として登録）
    dict.Add "あ", "a": dict.Add "い", "i": dict.Add "う", "u": dict.Add "え", "e": dict.Add "お", "o"
    dict.Add "か", "ka": dict.Add "き", "ki": dict.Add "く", "ku": dict.Add "け", "ke": dict.Add "こ", "ko"
    dict.Add "さ", "sa": dict.Add "し", "shi": dict.Add "す", "su": dict.Add "せ", "se": dict.Add "そ", "so"
    dict.Add "た", "ta": dict.Add "ち", "chi": dict.Add "つ", "tsu": dict.Add "て", "te": dict.Add "と", "to"
    dict.Add "な", "na": dict.Add "に", "ni": dict.Add "ぬ", "nu": dict.Add "ね", "ne": dict.Add "の", "no"
    dict.Add "は", "ha": dict.Add "ひ", "hi": dict.Add "ふ", "fu": dict.Add "へ", "he": dict.Add "ほ", "ho"
    dict.Add "ま", "ma": dict.Add "み", "mi": dict.Add "む", "mu": dict.Add "め", "me": dict.Add "も", "mo"
    dict.Add "や", "ya": dict.Add "ゆ", "yu": dict.Add "よ", "yo": dict.Add "ら", "ra": dict.Add "り", "ri"
    dict.Add "る", "ru": dict.Add "れ", "re": dict.Add "ろ", "ro": dict.Add "わ", "wa": dict.Add "を", "wo"
    dict.Add "ん", "n": dict.Add "が", "ga": dict.Add "ぎ", "gi": dict.Add "ぐ", "gu": dict.Add "げ", "ge"
    dict.Add "ご", "go": dict.Add "ざ", "za": dict.Add "じ", "ji": dict.Add "ず", "zu": dict.Add "ぜ", "ze"
    dict.Add "ぞ", "zo": dict.Add "だ", "da": dict.Add "ぢ", "ji": dict.Add "づ", "zu": dict.Add "で", "de"
    dict.Add "ど", "do": dict.Add "ば", "ba": dict.Add "び", "bi": dict.Add "ぶ", "bu": dict.Add "べ", "be"
    dict.Add "ぼ", "bo": dict.Add "ぱ", "pa": dict.Add "ぴ", "pi": dict.Add "ぷ", "pu": dict.Add "ぺ", "pe"
    dict.Add "ぽ", "po": dict.Add "きゃ", "kya": dict.Add "きゅ", "kyu": dict.Add "きょ", "kyo": dict.Add "しゃ", "sha"
    dict.Add "しゅ", "shu": dict.Add "しょ", "sho": dict.Add "しぇ", "she": dict.Add "ちゃ", "cha": dict.Add "ちゅ", "chu"
    dict.Add "ちょ", "cho": dict.Add "にゃ", "nya": dict.Add "にゅ", "nyu": dict.Add "にょ", "nyo": dict.Add "ひゃ", "hya": dict.Add "ひゅ", "hyu"
    dict.Add "ひょ", "hyo": dict.Add "みゃ", "mya": dict.Add "みゅ", "myu": dict.Add "みょ", "myo": dict.Add "りゃ", "rya"
    dict.Add "りゅ", "ryu": dict.Add "りょ", "ryo": dict.Add "ぎゃ", "gya": dict.Add "ぎゅ", "gyu": dict.Add "ぎょ", "gyo"
    dict.Add "じゃ", "ja": dict.Add "じゅ", "ju": dict.Add "じょ", "jo": dict.Add "ぢゃ", "ja": dict.Add "ぢゅ", "ju"
    dict.Add "ぢょ", "jo": dict.Add "びゃ", "bya": dict.Add "びゅ", "byu": dict.Add "びょ", "byo": dict.Add "ぴゃ", "pya"
    dict.Add "ぴゅ", "pyu": dict.Add "ぴょ", "pyo": dict.Add "きぇ", "kye"


    ' ヘボン式ローマ字に変換する
    For i = 1 To Len(hiragana)
        If i = Len(hiragana) Then ' 最後の文字の場合
            If Mid(hiragana, i, 1) = "う" Then  ' 苗字の最後が「う」の場合
                Exit For  '変換しない。
            Else
                 ' 辞書から該当するヘボン式ローマ字を取得し、ローマ字文字列に追加する
                romaji = romaji & dict(Mid(hiragana, i, 1))
            End If
        ' 2文字の辞書に存在する場合
        ElseIf dict.Exists(Mid(hiragana, i, 2)) Then
        ' 辞書から該当するヘボン式ローマ字を取得し、ローマ字文字列に追加する
            romaji = romaji & dict(Mid(hiragana, i, 2))
            ' 2文字分インクリメントする
            i = i + 2
        ElseIf dict.Exists(Mid(hiragana, i, 1)) Then
            ' 辞書から該当するヘボン式ローマ字を取得し、ローマ字文字列に追加する
            romaji = romaji & dict(Mid(hiragana, i, 1))
        Else
            ' 辞書に存在しない場合、ひらがな文字をそのままローマ字文字列に追加する
            romaji = romaji & Mid(hiragana, i, 1)
        End If
    Next i
    
    ' 関数の戻り値としてヘボン式ローマ字を返す
    kanaToHepburn = romaji
    
End Function
'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

Option Explicit

Sub createEmails() 'メールアドレスを生成

Dim i As Integer

Dim lastName As String

Dim firstName As String

Dim email As String

' ワークシートの使用範囲内の行数だけループする

For i = 2 To ActiveSheet.UsedRange.Rows.Count

'変数を初期化する

lastName = ""

firstName = ""

email = ""

' セルA列の値に全角スペースが含まれている場合

If InStr(Range("C" & i).Value, "　") > 0 Then

' 姓と名に分割する

lastName = Split(Range("C" & i).Value, "　")(0)

firstName = Split(Range("C" & i).Value, "　")(1)

' 姓と名をヘボン式ローマ字に変換する

lastName = kanaToHepburn(lastName)

firstName = kanaToHepburn(firstName)

' 姓と名が空でない場合にメールアドレスを作成する

If lastName <> "" And firstName <> "" Then

email = firstName & "." & lastName & Range("G1")

End If

' セルB列にメールアドレスを出力する

Range("D" & i).Value = email

Next i

End Sub

Function kanaToHepburn(ByVal kana As String) As String

Dim hiragana As String

Dim katakana As String

Dim i As Long

Dim romaji As String

Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

' カタカナをひらがなに変換する

hiragana = StrConv(kana, vbHiragana)

' 全角スペースを半角スペースに変換する

hiragana = Replace(hiragana, "　", " ")

' ヘボン式ローマ字に変換する（辞書として登録）

dict.Add "あ", "a": dict.Add "い", "i": dict.Add "う", "u": dict.Add "え", "e": dict.Add "お", "o"

dict.Add "か", "ka": dict.Add "き", "ki": dict.Add "く", "ku": dict.Add "け", "ke": dict.Add "こ", "ko"

dict.Add "さ", "sa": dict.Add "し", "shi": dict.Add "す", "su": dict.Add "せ", "se": dict.Add "そ", "so"

dict.Add "た", "ta": dict.Add "ち", "chi": dict.Add "つ", "tsu": dict.Add "て", "te": dict.Add "と", "to"

dict.Add "な", "na": dict.Add "に", "ni": dict.Add "ぬ", "nu": dict.Add "ね", "ne": dict.Add "の", "no"

dict.Add "は", "ha": dict.Add "ひ", "hi": dict.Add "ふ", "fu": dict.Add "へ", "he": dict.Add "ほ", "ho"

dict.Add "ま", "ma": dict.Add "み", "mi": dict.Add "む", "mu": dict.Add "め", "me": dict.Add "も", "mo"

dict.Add "や", "ya": dict.Add "ゆ", "yu": dict.Add "よ", "yo": dict.Add "ら", "ra": dict.Add "り", "ri"

dict.Add "る", "ru": dict.Add "れ", "re": dict.Add "ろ", "ro": dict.Add "わ", "wa": dict.Add "を", "wo"

dict.Add "ん", "n": dict.Add "が", "ga": dict.Add "ぎ", "gi": dict.Add "ぐ", "gu": dict.Add "げ", "ge"

dict.Add "ご", "go": dict.Add "ざ", "za": dict.Add "じ", "ji": dict.Add "ず", "zu": dict.Add "ぜ", "ze"

dict.Add "ぞ", "zo": dict.Add "だ", "da": dict.Add "ぢ", "ji": dict.Add "づ", "zu": dict.Add "で", "de"

dict.Add "ど", "do": dict.Add "ば", "ba": dict.Add "び", "bi": dict.Add "ぶ", "bu": dict.Add "べ", "be"

dict.Add "ぼ", "bo": dict.Add "ぱ", "pa": dict.Add "ぴ", "pi": dict.Add "ぷ", "pu": dict.Add "ぺ", "pe"

dict.Add "ぽ", "po": dict.Add "きゃ", "kya": dict.Add "きゅ", "kyu": dict.Add "きょ", "kyo": dict.Add "しゃ", "sha"

dict.Add "しゅ", "shu": dict.Add "しょ", "sho": dict.Add "しぇ", "she": dict.Add "ちゃ", "cha": dict.Add "ちゅ", "chu"

dict.Add "ちょ", "cho": dict.Add "にゃ", "nya": dict.Add "にゅ", "nyu": dict.Add "にょ", "nyo": dict.Add "ひゃ", "hya": dict.Add "ひゅ", "hyu"

dict.Add "ひょ", "hyo": dict.Add "みゃ", "mya": dict.Add "みゅ", "myu": dict.Add "みょ", "myo": dict.Add "りゃ", "rya"

dict.Add "りゅ", "ryu": dict.Add "りょ", "ryo": dict.Add "ぎゃ", "gya": dict.Add "ぎゅ", "gyu": dict.Add "ぎょ", "gyo"

dict.Add "じゃ", "ja": dict.Add "じゅ", "ju": dict.Add "じょ", "jo": dict.Add "ぢゃ", "ja": dict.Add "ぢゅ", "ju"

dict.Add "ぢょ", "jo": dict.Add "びゃ", "bya": dict.Add "びゅ", "byu": dict.Add "びょ", "byo": dict.Add "ぴゃ", "pya"

dict.Add "ぴゅ", "pyu": dict.Add "ぴょ", "pyo": dict.Add "きぇ", "kye"

' ヘボン式ローマ字に変換する

For i = 1 To Len(hiragana)

If i = Len(hiragana) Then ' 最後の文字の場合

If Mid(hiragana, i, 1) = "う" Then ' 苗字の最後が「う」の場合

Exit For '変換しない。

Else

' 辞書から該当するヘボン式ローマ字を取得し、ローマ字文字列に追加する

romaji = romaji & dict(Mid(hiragana, i, 1))

End If

' 2文字の辞書に存在する場合

ElseIf dict.Exists(Mid(hiragana, i, 2)) Then

' 辞書から該当するヘボン式ローマ字を取得し、ローマ字文字列に追加する

romaji = romaji & dict(Mid(hiragana, i, 2))

' 2文字分インクリメントする

i = i + 2

ElseIf dict.Exists(Mid(hiragana, i, 1)) Then

' 辞書から該当するヘボン式ローマ字を取得し、ローマ字文字列に追加する

romaji = romaji & dict(Mid(hiragana, i, 1))

Else

' 辞書に存在しない場合、ひらがな文字をそのままローマ字文字列に追加する

romaji = romaji & Mid(hiragana, i, 1)

End If

Next i

' 関数の戻り値としてヘボン式ローマ字を返す

kanaToHepburn = romaji

End Function

●実行前～実行後　※C列に登録されている「フリガナ」を元に、メールアドレスが作成されました。名前の姓と名が逆転したローマ字変換を行い。
例：カトウ　リョウタ　通常ローマ字変換すると：【　 ryouta.katou　】になるが、きちんと【　ryota.kato　】とヘボン式で変換されます。
（画面クリックして拡大）