記事公開日
【Excel VBA】宛名印刷のプロが公開！郵便カスタマバーコードを一発生成する関数スクリプト（表記ブレ自動整形機能付き）
皆さん、こんにちは。三栄ぷりんとです。
かつてこの三栄NAVIのブログで、「郵便のカスタマバーコードを自作しよう」というテーマで、郵政の仕様書をもとにした生成手順や、専用フォントを作ったお話をさせていただきました。
当時は、お客様からの宛名印刷のご依頼の中で、カスタマバーコード付加のご要望が増えることを見込んで準備した仕組みでしたが、実際のところ、個別の印刷依頼としての頻度はそれほど高くはありませんでした。
「せっかく実務レベルで磨き上げた仕組みを眠らせておくのはもったいない。それなら、日々の業務で大量の発送物や宛名管理をされている皆さんに、広く使って役立ててもらった方が良いのではないか」
そう思い立ち、今回は実際にExcel（エクセル）の関数としてそのまま使える「カスタマバーコード生成用VBAスクリプト」を、内部のクレンジング関数も含めて完全公開いたします！
【プロの現場でも大活躍する理由】
少しだけ印刷会社ならではの裏話をお話しします。 お客様から「返信用封筒」などの印刷をご依頼いただく際、郵便局から支給されたカスタマバーコードの「画像」をそのまま原稿（入稿データ）としてお持ち込みいただくケースがよくあります。
しかし、その画像が何度もコピーされたり縮小されたりして、非常にガビガビに崩れてしまっている（解像度が著しく低い）ことが少なくありません。バーコードの線が潰れたり歪んだりしていると、郵便局の機械で正しく読み取れず、割引が適用されないリスクが出てきます。
そんな時、私たちの現場では、お客様からいただいた住所データや郵便番号から、このスクリプトを使って綺麗で正確なバーコードデータを自社で再生成し、印刷品質を担保しています。
今回公開するコードは、単にバーコード文字列を作るだけでなく、「住所の表記ブレ」を自動で綺麗に整えるプロ仕様の処理（クレンジング機能）が盛り込まれています。
【カスタマバーコード生成VBAスクリプト】
ExcelのVBA（標準モジュール）に以下のコードをそのまま貼り付けることで、セル上で =yuubinBC(郵便番号, 住所, 住所付属) という関数が使えるようになります。
エクセルファイルはこちらから ⇒ 郵便カスタマバーコード
ちょっとながいですが コードを記述します。
'======================================================================
' 郵便カスタマバーコード生成メイン関数
'======================================================================
Function yuubinBC(in郵便番号, in住所, in住所付属)
Dim L1 As String, L2 As String, L3 As String
Dim 郵便 As String, 住所 As String, 住所付属 As String
郵便 = in郵便番号
郵便 = sujihankaku(郵便)
郵便 = yubin_del(郵便, 1)
住所 = sujihankaku(in住所)
住所付属 = sujihankaku(in住所付属)
L1 = henkan(住所)
L2 = henkan(住所付属)
If Not L2 = "" Then
L3 = L1 + L2
Else
L3 = L1
End If
yuubinBC = CREATE_C_BARCODE(郵便, L3)
End Function
'======================================================================
' 郵便番号の整形（「〒」やハイフンの削除）
'======================================================================
Function yubin_del(郵便番号, モード)
' モード 1：ハイフンなしの7桁（0000000）
' モード 2：ハイフンあり（000-0000）
Dim yua As String, az As String, ay As String, jj As String
yua = Left(郵便番号, 1)
If yua = "〒" Then
郵便番号 = Mid(郵便番号, 2, 10)
End If
郵便番号 = StrConv(郵便番号, 8) ' 半角へ変換
jj = Mid(郵便番号, 4, 1)
If jj = "-" Then
If モード = 1 Then
az = Mid(郵便番号, 1, 3)
ay = Mid(郵便番号, 5, 9)
az = az + ay
Else
az = 郵便番号
End If
Else
If モード = 1 Then
az = 郵便番号
Else
az = Mid(郵便番号, 1, 3)
ay = Mid(郵便番号, 4, 9)
az = az + "-" + ay
End If
End If
yubin_del = az
End Function
'======================================================================
' 数字・ハイフンの半角統一化
'======================================================================
Function sujihankaku(moji)
moji = Replace(moji, "１", "1")
moji = Replace(moji, "２", "2")
moji = Replace(moji, "３", "3")
moji = Replace(moji, "４", "4")
moji = Replace(moji, "５", "5")
moji = Replace(moji, "６", "6")
moji = Replace(moji, "７", "7")
moji = Replace(moji, "８", "8")
moji = Replace(moji, "９", "9")
moji = Replace(moji, "０", "0")
moji = Replace(moji, "ー", "-")
moji = Replace(moji, "‐", "-")
moji = Replace(moji, "-", "-")
moji = Replace(moji, "―", "-")
moji = Replace(moji, "－", "-")
moji = Replace(moji, "‐", "-")
sujihankaku = moji
End Function
'======================================================================
' 住所データのクレンジングと抽出
'======================================================================
Function henkan(ch_in)
Dim bb As Integer, dd As Integer
Dim i1 As String, i2 As String, ch As String, o_ch As String
Dim B_data_1 As String, B_data_2 As String
Dim aji_f As Integer, aji_rf As Integer, aji_i As Integer, aji_1 As Integer
ch = ch_in
ch = StrConv(ch, 1) ' 大文字化
ch = StrConv(ch, 8) ' 半角化
bb = Len(ch)
If bb >= 1 Then
For dd = 1 To bb Step 1
ch = Replace(ch, "Ⅰ", "1")
ch = Replace(ch, "Ⅱ", "2")
ch = Replace(ch, "Ⅲ", "3")
ch = Replace(ch, "Ⅳ", "4")
ch = Replace(ch, "Ⅴ", "5")
ch = Replace(ch, "Ⅵ", "6")
ch = Replace(ch, "Ⅶ", "7")
ch = Replace(ch, "Ⅷ", "8")
ch = Replace(ch, "Ⅸ", "9")
ch = Replace(ch, "Ⅹ", "10")
ch = Replace(ch, "&", "")
ch = Replace(ch, "/", "")
ch = Replace(ch, "･", "")
ch = Replace(ch, ",", "")
ch = Replace(ch, ".", "")
ch = Replace(ch, """", "")
ch = Replace(ch, "―", "-")
ch = Replace(ch, "ー", "-")
ch = Replace(ch, "‐", "-")
ch = Replace(ch, "ｰ", "-")
ch = Replace(ch, "階", "-")
Next dd
End If
' 丁番地漢字の処理
ch = T_kj(ch, "丁目")
ch = T_kj(ch, "丁")
ch = T_kj(ch, "番地")
ch = T_kj(ch, "番")
ch = T_kj(ch, "号")
ch = T_kj(ch, "地割")
ch = T_kj(ch, "線")
' 必要な文字（数字・アルファベット）以外をハイフンに置換
o_ch = ""
bb = Len(ch)
If bb >= 1 Then
For dd = 1 To bb Step 1
i1 = Mid(ch, dd, 1)
If (i1 <= "9" And i1 >= "0") Or (i1 <= "Z" And i1 >= "A") Then
o_ch = o_ch + i1
Else
o_ch = o_ch + "-"
End If
Next dd
End If
ch = o_ch
' アルファベット（英文字）の精査処理
o_ch = ""
aji_f = 0: aji_rf = 0
bb = Len(ch)
If bb >= 1 Then
For dd = 1 To bb Step 1
i2 = i1
i1 = Mid(ch, dd, 1)
If (i1 <= "Z" And i1 >= "A") Then
If aji_f = 0 Then
i2 = i1
aji_f = 1
aji_i = dd
Else
aji_rf = 1
aji_i = dd
End If
Else
If aji_f = 1 Then
If aji_rf = 1 Then
aji_1 = dd
o_ch = o_ch + i1
Else
aji_1 = dd
If i1 = "F" Then
o_ch = o_ch + i2
Else
o_ch = o_ch + i2 + i1
End If
End If
Else
o_ch = o_ch + i1
End If
aji_f = 0: aji_rf = 0
End If
If dd = bb Then
If aji_f = 1 And aji_rf = 0 Then
If i1 = "F" Then
'処理なし
Else
o_ch = o_ch + i1
End If
End If
End If
Next dd
End If
ch = o_ch
' Fの前が数字の場合のハイフン変換
bb = Len(ch)
If bb >= 1 Then
bb = InStr(ch, "F")
If bb >= 1 Then
B_data_1 = Mid(ch, 1, bb - 1)
B_data_2 = Mid(ch, bb + 1, 100)
ch = B_data_1 + "-" + B_data_2
End If
End If
' 連続するハイフンの整理
o_ch = ""
bb = Len(ch)
If bb >= 1 Then
For dd = 1 To bb Step 1
i2 = i1
i1 = Mid(ch, dd, 1)
If i1 = "-" Then
If aji_f = 0 Then
i2 = i1
aji_f = 1
aji_i = dd
Else
aji_rf = 1
aji_i = dd
End If
Else
If aji_f = 1 Then
If aji_rf = 1 Then
aji_1 = dd
o_ch = o_ch + "-" + i1
Else
aji_1 = dd
o_ch = o_ch + "-" + i1
End If
Else
o_ch = o_ch + i1
End If
aji_f = 0: aji_rf = 0
End If
Next dd
End If
ch = o_ch
' 英字前後の不要なハイフン除去
o_ch = ""
bb = Len(ch)
If bb >= 1 Then
For dd = 1 To bb Step 1
i1 = Mid(ch, dd, 1)
If i1 = "-" Then
If Mid(ch, dd + 1, 1) <= "Z" And Mid(ch, dd + 1, 1) >= "A" Then
' 除去
Else
o_ch = o_ch & i1
End If
Else
o_ch = o_ch & i1
End If
Next dd
End If
ch = o_ch
o_ch = ""
bb = Len(ch)
If bb >= 1 Then
For dd = 1 To bb Step 1
i1 = Mid(ch, dd, 1)
If i1 = "-" Then
If dd >= 2 Then
If Mid(ch, dd - 1, 1) <= "Z" And Mid(ch, dd - 1, 1) >= "A" Then
' 除去
Else
o_ch = o_ch & i1
End If
End If
Else
o_ch = o_ch & i1
End If
Next dd
End If
ch = o_ch
' スペース削除
ch = Replace(ch, " ", "")
' 先頭のハイフン削除
If Mid(ch, 1, 1) = "-" Then
ch = Mid(ch, 2)
End If
henkan = ch
End Function
'======================================================================
' 漢数字表記の自動修正・展開（「一」～「十」対応）
'======================================================================
Function T_kj(ch_in, K_moji)
Dim lengs As Integer, K_moji_ln As Integer, bb As Integer, dd As Integer
Dim B_data_1 As String, B_dara_2 As String, i1 As String, aa As String
Dim k_f1 As Integer, ln_10 As Integer, k_10 As Integer
lengs = Len(ch_in)
K_moji_ln = Len(K_moji)
bb = InStr(ch_in, K_moji)
If bb > 1 Then
B_data_1 = Mid(ch_in, 1, bb - 1)
B_dara_2 = Mid(ch_in, bb + K_moji_ln, 100)
i1 = Mid(B_data_1, bb - 1, 1)
If i1 = "一" Or i1 = "二" Or i1 = "三" Or i1 = "四" Or i1 = "五" Or i1 = "六" Or i1 = "七" Or i1 = "八" Or i1 = "九" Or i1 = "〇" Or i1 = "十" Then
k_f1 = 1: ln_10 = bb: k_10 = 0
For dd = 1 To (bb - 1) Step 1
i1 = Mid(B_data_1, bb - dd, 1)
If k_f1 = 1 Then
Select Case i1
Case "一": i1 = IIf(k_10 = 1, "10", "1")
Case "二": i1 = IIf(k_10 = 1, "20", "2")
Case "三": i1 = IIf(k_10 = 1, "30", "3")
Case "四": i1 = IIf(k_10 = 1, "40", "4")
Case "五": i1 = IIf(k_10 = 1, "50", "5")
Case "六": i1 = IIf(k_10 = 1, "60", "6")
Case "七": i1 = IIf(k_10 = 1, "70", "7")
Case "八": i1 = IIf(k_10 = 1, "80", "8")
Case "九": i1 = IIf(k_10 = 1, "90", "9")
Case "〇": i1 = "0"
Case "十": k_10 = dd: i1 = ""
Case Else
If k_10 = 1 Then i1 = i1 + "10" Else If k_10 = 2 Then i1 = i1 + "1"
k_f1 = 0
End Select
End If
aa = i1 + aa
Next dd
If k_10 = dd - 1 Then
If k_10 = 1 Then i1 = "10" Else If k_10 = 2 Then i1 = "1" + i1
aa = i1 + aa
End If
aa = aa + "-" + B_dara_2
Else
aa = B_data_1 + "-" + B_dara_2
End If
T_kj = aa
Else
T_kj = ch_in
End If
End Function
'======================================================================
' カスタマバーコード文字列 生成コアロジック（チェックデジット算出）
'======================================================================
Public Function CREATE_C_BARCODE(YOU_NO As Variant, ADD_NUM As Variant) As String
Dim str_data1 As String, str_data2 As String
Dim work_num1 As Integer, work_num2 As Integer
Dim cnt As Integer, sum_chk As Integer, str_len As Integer
Dim bar_data_str As String, prnt_dat As String
Const sum_chk_tbl = "123456789-ABCDEFGH"
Const STR_CC1 = 11
If IsNull(YOU_NO) = True Then
CREATE_C_BARCODE = ""
Exit Function
End If
If IsNull(ADD_NUM) = True Then ADD_NUM = ""
str_data1 = Trim$(StrConv(YOU_NO, vbNarrow))
str_data2 = ""
For cnt = 1 To Len(str_data1)
If (Mid$(str_data1, cnt, 1) <> "-") And (Mid$(str_data1, cnt, 1) <> " ") Then
str_data2 = str_data2 & Mid$(str_data1, cnt, 1)
End If
Next cnt
If Len(str_data2) <> 7 Then
CREATE_C_BARCODE = ""
Exit Function
End If
bar_data_str = str_data2
str_data1 = ADD_NUM
If Len(str_data1) < 13 Then
str_data2 = str_data1 & String(13 - Len(str_data1), "d")
Else
str_data2 = Left$(str_data1, 13)
End If
bar_data_str = bar_data_str & str_data2
str_len = 0: sum_chk = 0: prnt_dat = ""
For cnt = 1 To Len(bar_data_str)
str_data1 = Mid$(bar_data_str, cnt, 1)
Select Case Asc(str_data1)
Case Asc("0") To Asc("9")
str_len = str_len + 1
work_num1 = Val(str_data1)
prnt_dat = prnt_dat & str_data1
Case Asc("A") To Asc("J")
str_len = str_len + 2
work_num2 = (Asc(str_data1) - Asc("A"))
work_num1 = STR_CC1 + work_num2
If work_num2 = 0 Then
prnt_dat = prnt_dat & "A" & "0"
Else
prnt_dat = prnt_dat & "A" & Mid$(sum_chk_tbl, work_num2, 1)
End If
Case Asc("K") To Asc("T")
str_len = str_len + 2
work_num2 = (Asc(str_data1) - Asc("K"))
work_num1 = (STR_CC1 + 1) + work_num2
If work_num2 = 0 Then
prnt_dat = prnt_dat & "B" & "0"
Else
prnt_dat = prnt_dat & "B" & Mid$(sum_chk_tbl, work_num2, 1)
End If
Case Asc("U") To Asc("Z")
str_len = str_len + 2
work_num2 = (Asc(str_data1) - Asc("U"))
work_num1 = (STR_CC1 + 2) + work_num2
If work_num2 = 0 Then
prnt_dat = prnt_dat & "C" & "0"
Else
prnt_dat = prnt_dat & "C" & Mid$(sum_chk_tbl, work_num2, 1)
End If
Case Asc("a") To Asc("h")
str_len = str_len + 1
work_num1 = STR_CC1 + (Asc(str_data1) - Asc("a"))
prnt_dat = prnt_dat & "D"
Case Asc("-")
str_len = str_len + 1
work_num1 = 10
prnt_dat = prnt_dat & str_data1
Case Else
CREATE_C_BARCODE = ""
Exit Function
End Select
sum_chk = sum_chk + work_num1
Select Case True
Case str_len = 20
bar_data_str = Left$(bar_data_str, cnt)
Exit For
Case str_len > 20
sum_chk = sum_chk - work_num2
bar_data_str = Left$(bar_data_str, 19)
prnt_dat = Left$(prnt_dat, 20)
Exit For
End Select
Next cnt
If (sum_chk Mod 19) = 0 Then
bar_data_str = prnt_dat & "0"
Else
bar_data_str = prnt_dat & Mid$(sum_chk_tbl, 19 - (sum_chk Mod 19), 1)
End If
bar_data_str = "(" & bar_data_str & ")"
bar_data_str = StrConv(bar_data_str, 1)
CREATE_C_BARCODE = bar_data_str
End Function
【プロが解説！このスクリプトのここがスゴイ】
郵便局の仕様書通りに組むだけでは、実は実務でエラーが多発します。このスクリプトに組み込まれた、現場ならではの「3つのこだわりポイント」を紹介します。
1. 漢数字の自動変換と「十」への対応（T_kj関数）
住所録には「三丁目」や「十五番地」といった漢数字が混在しがちです。このスクリプトは、指定したキーワード（丁目・番地・号など）の前の漢数字を認識し、算用数字に自動変換します。特に「十一（11）」や「二十（20）」のように、桁の概念を持つ「十」の処理もロジックに組み込まれているため、表記がバラバラな名簿でもそのまま読み込めます。
2. ビル名や「階」・アルファベットのクレンジング
バーコードの生成に必要なのは「地番の数字」や「部屋番号」です。スクリプト内では、「Ⅰ、Ⅱ」といったローマ数字をアラビア数字に直したり、「〇階」の「階」をハイフンに置き換えたり、不要な記号（&や/など）を自動で排除・整理する処理が入っています。
3. 正確なチェックデジットとスタート・ストップコード
カスタマバーコードは、前後に「( )」に該当するスタート・ストップコードが必要です。また、データの信頼性を担保する「チェックデジット（19の剰余計算）」も、アルファベット混じりの複雑な計算に対応し、完全に自動算出します。
【エクセルでの使い方】
-
VBAの登録：Excelを開き、
Alt + F11でVBAエディタを開きます。「挿入」＞「標準モジュール」を選択し、上記のコードを貼り付けて閉じます。 -
セルの入力： 例えば、A2セルに「郵便番号」、B2セルに「住所」が入っている場合、バーコードを表示したいセルに以下のように入力します。
=yuubinBC(A2, B2, "") -
フォントの指定： 関数を入力したセルのフォントを、以前ご紹介した「カスタマバーコード専用フォント」に指定してください。英数字の羅列から、一瞬で綺麗なバーコードに切り替わります！
【終わりに】
今回ご紹介した関数は、私たちが印刷物の宛名処理を行う中で、少しずつ改良を重ねてきた実務直結のロジックです。 名簿の表記が少々荒れていても、この関数が自動でクレンジングを行ってくれるため、手作業で住所を直す手間が大幅に削減されます。
社内での発送業務の効率化や、綺麗な宛名・返信用封筒作りにぜひお役立てください！
「データ数が万単位でエクセルが重くなってしまう」「フォントの配置やレイアウトが崩れてしまう」といった場合は、いつでもお気軽に三栄ぷりんとまでご相談ください。
