Attribute VB_Name = "TelephoneCheck" Option Explicit '//-【 VBA/VB6 移植版 TelephoneCheck_VBA.bas (Ver 1.00 , 翻訳テーブル:2022/7/1 版) 】--------------------------- '// '// 電話番号のハイフン検証/編集関数 ( ValidateTelephone / FormatTelephone / GetTypeTelephone ) '// '// 【 移植元ソース:番号翻訳テーブル 内包版 TelephoneCheck.js 】 '// '// Tips29: JavaScriptで電話番号(局番)のハイフン検証/編集 '// http://addinbox.sakura.ne.jp/Excel_Tips29.htm '// '// Author : AddinBox(角田) http:'//addinbox.sakura.ne.jp/ '// '// β 1.00 , 2019/ 2/14 (JavaScript版 初版) '// β 4.40 , 2019/ 3/27 (JavaScript版) '// β 4.40 , 2019/ 3/29 (VBA/VB6 移植) '// β 4.50 , 2019/ 4/ 4 (VBA/VB6 移植) '// - - - - - - - - - - - - '// Ver 1.00 , 2019/ 4/ 4 (VBA/VB6 移植, 番号翻訳テーブル:2019/4/1 版) '// Ver 1.00 , 2019/ 5/11 (VBA/VB6 移植, 番号翻訳テーブル:2019/5/7 版) '// Ver 1.00 , 2020/ 7/20 (VBA/VB6 移植, 番号翻訳テーブル:2020/6/1 版) '// Ver 1.00 , 2022/ 8/ 2 (VBA/VB6 移植, 番号翻訳テーブル:2022/7/1 版) '// '// *1 固定電話番号は番号翻訳テーブルによって、全国の市外局番を忠実に判定します。 '// 下記で翻訳テーブルの仕組みを確認できます。 '// [ 電話番号翻訳テーブル 翻訳シュミレーター ] '// http://addinbox.sakura.ne.jp/Excel_Tips29.htm#S2_2 '//------------------------------------------------------------------------------- '// 【 サポートしている電話番号 】 '// 固定電話 10桁(先頭 0) [ 0ABCDE-FGHJ ] '// 携帯電話 11桁(先頭 070/080/090) [ 0x0-CDEF-GHJK , C:1-9 ] 補:060は実施未定 '// 着信課金 10桁(先頭 0120) [ 0120-DEF-GHJ ] '// 着信課金 11桁(先頭 0800) [ 0800-DEF-GHJK ] '// IP電話 11桁(先頭 050) [ 050-CDEF-GHJK , C:1-9 ] '// M2M 11桁(先頭 020x) [ 020-CDE-FGHJK , C:1-3,5-9 ] '// ポケベル 11桁(先頭 0204) [ 020-4DE-FGHJK ] '// FMC 11桁(先頭 0600) [ 0600-DEF-GHJK ] '// 情報料代理徴収 10桁(先頭 0990) [ 0990-DEF-GHJ ] '// 全国統一番号 10桁(先頭 0570) [ 0570-DEF-GHJ ] '//------------------------------------------------------------------------------- Private RegExp As Object '// 正規表現用 VBScript.RegExpオブジェクト '//------------------------------------------------------------------------------- '// VBA/VB6版では返却値のスタイルはユーザー定義型(Type) '// ( ValidateTelephone , FormatTelephone , GetTypeTelephone 共通 ) '// ※ Typeステートメントはモジュールレベル宣言なので全てのプロシジャーの前に置く事 '//------------------------------------------------------------------------------- Public Type TelephoneStruct TelType As Integer EditType As Integer TelEdit As String ErrId As Integer SizeAll As Integer Size1 As Integer Size2 As Integer Size3 As Integer End Type ' 番号翻訳テーブル(2022/7/1 版) ' 固定電話の全国の局番(市外局番+市内局番)および携帯電話(070/080/090)等の局番を ' 収録しているJSONファイル(AreaCode4JSON.json)を必要最小限の内容に編集しています。 ' 完全版のフォーマットは [ http://addinbox.sakura.ne.jp/Excel_Tips29.htm ] を参照の事。 ' 尚、このVBA用データはJSONファイル作成ツールで一緒に作成していますので、 '「配列データ」の同一性/正確性は保障します。 ' ' VBA では配列の定数定義が出来ない為、セミコロン(第1次元)&カンマ(第2次元)区切りの ' テキストデータで定義し、Split関数で配列にする。 ' 行継続文字(アンダーバー)の個数制限がある為、10ブロック/行にしている。 ' Private vntAreaCodeArray As Variant ' Splitにより動的配列(1次元)を格納する Private Const cstArrayCount As Integer = 136 Private Const cstAreaCodeData As String = _ "0,1,22,41,42,54,69,70,81,114;0,-3,2,4,7,10,15,19,20,21;-103,0,0,-4,-4,-4,3,0,0,0;0,0,-4,-4,-4,-4,-4,-5,0,0;0,0,0,-4,-4,-4,-4,5,-4,6;0,0,-5,0,-5,-4,-4,-5,-4,0;0,0,-5,-4,-4,-4,-4,-5,-5,0;0,0,-4,-4,-4,8,9,0,0,0;0,0,-4,-4,-4,0,-5,-5,0,0;0,0,-4,-4,-4,-4,-5,0,0,0;" & _ "0,0,-4,-4,11,12,13,-4,14,0;0,0,-4,-4,-4,-4,-4,-5,-3,-4;0,-3,-4,-4,-4,-4,-4,-3,-5,-4;0,0,-4,-4,-5,0,-4,-4,0,0;0,0,-4,-4,-4,-4,-5,-5,-4,0;0,0,-4,16,17,18,-4,-4,0,0;0,0,-5,0,-5,-5,-4,0,-4,-4;0,0,-4,-4,-4,-4,-4,0,-5,0;0,0,-4,-4,-5,-5,-5,0,-5,0;0,0,-4,-4,-4,-4,-4,-3,-4,-4;" & _ "0,0,-4,-4,-4,-4,-4,-4,-3,0;0,-4,-4,-4,-4,-4,-3,-4,-4,-3;130,0,23,25,26,27,32,34,36,39;-4,0,-3,24,-4,-4,-4,-3,-4,-4;-3,0,-4,-4,-3,-3,-3,-3,-3,-3;0,0,0,-4,-4,-4,-3,-4,-4,0;-4,-4,-4,-4,-4,-3,-4,-4,-4,-3;-4,0,-3,-3,-4,28,29,30,31,-4;-3,-3,-3,-3,-3,-3,-3,-4,-4,-3;-3,0,0,-4,-4,-4,-4,-4,-4,-4;" & _ "-3,-3,-4,-4,-4,-3,-3,-3,-3,-3;-3,0,-4,-4,-4,-4,-4,-4,-4,-4;-4,-4,-3,-4,33,-4,-4,-4,-4,-4;-3,0,-4,-4,-4,-4,-3,-3,-3,0;-4,0,-3,-3,-4,0,-4,-4,35,-4;0,0,-4,-4,0,-4,-4,-4,-3,-3;-4,0,-4,37,-4,-4,-3,-4,-4,38;-3,0,-4,-3,-3,-4,-4,0,-4,-4;-3,0,0,0,0,-3,-4,-4,-4,-4;0,-4,-3,40,-4,-4,-4,-4,-3,-4;" & _ "-3,0,-4,-4,-4,-3,-3,0,-3,0;0,0,0,-2,-2,-2,-2,0,0,0;0,0,43,47,-3,-3,48,49,51,52;-2,0,44,-3,-3,-3,-3,-3,45,46;-3,0,-4,-4,-4,-4,-4,-4,-4,-4;-3,-3,-4,-4,-3,-3,-3,-4,-4,0;-2,-3,-2,-2,-2,-2,-2,-3,-3,-2;0,0,-3,-3,-3,0,-4,0,-4,-4;-4,0,-3,-4,-3,-4,-4,-4,-3,0;50,-2,0,-3,-3,-4,-4,-3,-4,-4;" & _ "-2,0,-4,-4,-4,-4,-4,-4,-4,-2;-4,0,-3,0,-3,-3,-3,-3,-3,-3;0,0,-3,-4,-4,-4,0,0,0,53;0,0,-5,0,-5,0,-5,0,-5,0;131,0,-3,55,59,60,61,62,64,65;0,-4,-4,-4,-3,-3,-4,-4,-4,56;0,0,-3,0,0,0,57,58,-3,0;0,-4,-4,-4,-3,-3,-3,-3,-3,-3;0,0,0,-3,-4,0,0,-4,0,0;0,0,-3,-3,-4,-4,-3,-4,-4,-3;" & _ "-4,-4,-3,-4,-4,-4,-4,-4,-4,-3;0,-4,-4,-4,-4,-4,-4,-4,-4,-4;-110,0,-4,-4,-4,-4,63,-4,-4,0;0,0,-4,-4,-4,-4,-4,-4,0,-5;0,-4,-3,-3,-4,-4,-4,-4,0,0;0,0,-3,-3,-4,-4,-4,66,-4,68;0,0,-4,-4,-4,0,0,-4,-4,67;0,0,-5,-5,-5,-5,-5,-4,-4,-5;0,0,-4,-4,-4,-4,-4,-4,-4,-3;132,0,0,0,-2,0,-2,-2,0,0;" & _ "133,0,71,72,73,-3,75,76,-3,77;0,-4,-3,-3,-3,-4,-3,-3,-3,-3;0,0,0,0,-3,-4,-4,-4,-4,-4;-4,0,-4,-4,-4,-4,74,-4,-4,-4;0,0,0,-4,-4,-4,-4,0,-5,0;0,-4,-3,-4,-3,-4,-4,-4,-4,0;-4,-4,-4,-4,-4,-3,-4,0,-4,-4;-4,-4,-3,-3,78,79,80,-4,-4,-4;0,0,-3,-3,-3,-3,-4,-4,-4,-3;-3,0,-4,-4,-4,-3,-3,-4,-4,-3;" & _ "-3,0,-4,-4,-4,-4,-3,-3,-4,-4;134,0,82,87,94,96,98,111,112,113;-4,0,-3,-4,83,-3,-4,-4,-3,84;-3,0,-3,-3,-4,-4,-4,-4,-4,-3;-3,0,85,-4,86,-4,-3,-4,-4,0;-4,-3,-3,-3,-3,-3,-3,-3,-3,-3;-4,-3,-3,-3,-4,-4,0,0,0,0;0,0,-3,-4,-4,-4,88,89,91,92;-3,0,-4,-4,-4,-4,-4,-4,-4,-4;0,0,-4,-4,-4,-4,90,-3,-3,0;" & _ "-4,0,-4,-4,-4,-4,-3,-3,-3,-4;0,0,-4,-4,-4,-4,0,-5,-5,0;-3,0,-3,-3,-3,-3,93,-3,-3,-3;0,0,-5,-3,0,-5,-3,-5,-5,0;0,0,0,0,0,-4,-4,95,-4,-3;0,0,-4,-4,-4,-4,-4,-5,-4,0;0,97,-4,-4,-4,-4,-4,-4,-4,-4;0,0,-5,0,-5,0,0,0,0,0;0,0,-3,99,-3,101,103,105,108,109;0,0,-4,-4,-4,-4,100,-4,-4,0;" & _ "0,0,-3,-3,-3,0,-4,0,-3,0;0,0,-3,0,-4,102,-4,-4,0,0;-4,0,-3,0,-4,0,0,0,-4,0;-3,0,-4,-4,-4,-4,-4,-4,-4,104;-4,-3,-4,-4,-4,-4,-4,-3,-3,-4;0,0,106,107,-4,-4,-4,-4,-4,-4;0,0,-3,-3,-3,-4,-3,-4,-3,0;0,0,0,-4,-4,-4,-4,-3,-3,0;-3,0,-4,-4,-4,-4,-4,-4,-4,-3;-3,0,-4,-4,-3,-3,-4,-4,-4,110;" & _ "0,0,-4,-4,0,-3,0,-3,0,-3;0,0,0,0,0,-4,0,-4,-3,-4;-4,0,0,-4,-4,-4,-3,-4,-3,-4;0,0,-4,-4,-4,-4,-4,-4,-4,-3;135,0,115,116,117,118,119,120,121,123;-4,0,-3,-3,-3,-3,-3,-3,-3,-3;-4,0,-3,-3,-3,-3,-3,-3,-3,-3;-4,0,-4,-4,-4,0,-4,-4,-4,-4;-4,0,-4,0,-4,-4,-4,-4,-3,-4;0,0,-3,-3,-4,-4,-4,-4,-4,-4;" & _ "0,0,-4,-4,-4,-3,0,-4,-4,-4;122,0,-4,-4,-4,-4,-4,-4,-3,-3;0,0,-5,-4,-4,-4,-4,-4,-4,-4;-109,124,-3,125,128,-4,129,-4,-3,0;0,0,-5,-5,0,0,0,0,0,0;0,0,-4,126,127,-4,-4,-4,-4,0;0,-3,-4,-4,-4,-4,-4,-4,-4,-4;-4,-4,0,-3,0,-3,0,-3,0,-4;-3,0,-4,-4,-4,-4,-4,-3,-3,-4;0,0,-4,-4,-4,-4,-4,-4,-4,-5;" & _ "0,-106,-106,-106,-107,-106,-106,-106,-106,-106;0,-105,-105,-105,-105,-105,-105,-105,-105,-105;-108,0,0,0,0,0,0,0,0,0;0,-102,-102,-102,-102,-102,-102,-102,-102,-102;-104,-102,-102,-102,-102,-102,-102,-102,-102,-102;0,-102,-102,-102,-102,-102,-102,-102,-102,-102" '//--------------------------------------------------------------------- '// 番号翻訳テーブルのテキストデータ(cstAreaCodeData)から '// [idx1,idx2]の値を取得する(Zero オリジン) '//--------------------------------------------------------------------- Private Function getAreaCodeArrayElement(ByVal idx1 As Integer, ByVal idx2 As Integer) As Integer Dim vntNumberBlockArray As Variant '// テキストデータから動的配列(1次元)を生成する '// モジュール変数なので2回目以降は配列化処理をスキップ可能 If ((VarType(vntAreaCodeArray) And vbArray) = vbArray) Then If (UBound(vntAreaCodeArray) <> (cstArrayCount - 1)) Then Erase vntAreaCodeArray vntAreaCodeArray = Split(cstAreaCodeData, ";") '// 1次元目はセミコロン区切り End If Else vntAreaCodeArray = Split(cstAreaCodeData, ";") End If vntNumberBlockArray = Split(vntAreaCodeArray(idx1), ",") '// 2次元目はカンマ区切り getAreaCodeArrayElement = vntNumberBlockArray(idx2) End Function '//------------------------------------------------------------------------------- '// TelephoneStruct ユーザー定義型の初期化関数 '// ( ValidateTelephone , FormatTelephone , GetTypeTelephone 共通 ) '//------------------------------------------------------------------------------- Public Function InitTelephone() As TelephoneStruct Dim Temp As TelephoneStruct Temp.TelType = -1 Temp.EditType = 9 Temp.TelEdit = "" Temp.ErrId = 0 Temp.SizeAll = 0 Temp.Size1 = 0 Temp.Size2 = 0 Temp.Size3 = 0 InitTelephone = Temp End Function '//------------------------------------------------------------------------------- '// 正規表現チェック '//------------------------------------------------------------------------------- Private Function RegExpCheck(ByVal Target As String, ByVal Pattern As String) As Boolean '// RegExp(モジュール変数:Private)オブジェクトの生成 '// 初回(Nothing 時)のみ、オブジェクトを CreateObject で生成する。 '// オブジェクト解放はアプリケーション終了時の自動解放または '// [ FreeRegExpTelephone ] で行なう。 If (RegExp Is Nothing) Then Set RegExp = CreateObject("VBScript.RegExp") End If With RegExp .Pattern = Pattern .IgnoreCase = False .Global = True End With RegExpCheck = RegExp.Test(Target) End Function '//------------------------------------------------------------------------------- '// 正規表現チェック用オブジェクト(VBScript.RegExp)の消去 ( Sub FreeRegExpTelephone ) '// '// マクロの一覧に載らないようにダミー引数を設けています。 '// 引数には 0 を指定してください。 '// '// -- 補足説明 -- '// VBA/VB6版では、正規表現処理で [ CreateObject("VBScript.RegExp") ] を '// 使用しています。オブジェクトを毎回生成すると処理速度が非常に落ちる為、 '// VBScript.RegExpオブジェクトは【モジュールレベル変数】としています。 '// FreeRegExpTelephone はモジュールレベル変数のRegExpを解放する為のサブルーチンです。 '// 尚、このサブルーチンを使わず、アプリケーション終了時の自動解放に任せても構いません。 '//------------------------------------------------------------------------------- Public Sub FreeRegExpTelephone(ByVal Dummy As Variant) Set RegExp = Nothing End Sub '//------------------------------------------------------------------------------- '// 電話番号のフォーマット&検証 ( PhoneNumber ) '// --- ValidateTelephone/FormatTelephone の簡易インターフェース --- '// '// TelCode -- 半角文字列[ 0-9, -, (, ) ] '// 固定電話/携帯電話などの[ハイフン/括弧]編集 or 未編集電話番号 '// '// Action -- "V" : 電話番号の検証 '// "F1"〜"F6" : 電話番号の区切り編集( 2桁目が EditType の値 ) '// '// 返却値 '// Action= "V" -- 0: 検証エラー , 1:検証OK , 2:検証OK(電話番号が数字のみ) '// (Boolean 変換すると 0⇒False, 1/2⇒True になります) '// '// = "F1"〜"F6" -- 電話番号が正しい場合: EditType(2桁目)に従って編集した電話番号 '// 電話番号が誤っている場合: "Phone Error" '// '// 上記以外 -- "" (Boolean変換でFalse)で返ります。 '// '//------------------------------------------------------------------------------- Public Function PhoneNumber(ByVal TelCode As String, ByVal Action As String) As Variant '// FormatTelephone/ValidateTelephone の返却値 Dim Result As TelephoneStruct Result = InitTelephone() Const cstPatternAction = "^(([Ff][1-6])|[Vv])$" '// "F1"〜"F6" or "V" If (RegExpCheck(Action, cstPatternAction) = False) Then PhoneNumber = "" Exit Function End If If (UCase(Action) = "V") Then Result = ValidateTelephone(TelCode) Select Case Result.ErrId Case 0 PhoneNumber = 1 '// OK(Boolean変換でTrue) Case 8 PhoneNumber = 2 '// OK (電話番号が数字のみ, Boolean変換でTrue) Case Else PhoneNumber = 0 '// エラー(Boolean変換でFalse) End Select Else Result = FormatTelephone(TelCode, CInt(Mid(Action, 2, 1))) If (Result.ErrId = 0) Then PhoneNumber = Result.TelEdit Else PhoneNumber = "Phone Error" End If End If End Function '//------------------------------------------------------------------------------- '// 電話番号の検証 ( ValidateTelephone ) '// '// TelCode -- 半角文字列[ 0-9, -, (, ) ] '// 固定電話/携帯電話などの[ハイフン/括弧]編集 '// '// 返却値 -- {TelType, EditType, TelEdit, ErrId} の連想配列 '// TelType 1:固定電話(10桁), 2:携帯電話(070/080/090,11桁), 3:着信課金(0120,10桁), '// 4:着信課金(0800,11桁), 5:IP電話(050,11桁), 6:M2M(020x,11桁,x≠4), '// 7:ポケベル(0204,11桁), 8:FMC(0600,11桁), 9:情報料徴収(0990,10桁), '// 10:統一番号(0570,10桁), -1:other '// '// EditType 1or4: 0AB-CDE-FGHJ, 2or5: 0AB(CDE)FGHJ, 3or6: (0AB)CDE-FGHJ, 9:other '// 携帯電話のみ、[3-4-4 桁]で区切る⇒1〜3 , [3-3-5 桁]で区切る⇒4〜6 '// '// TelEdit TelType/EditType で編集し直された電話番号(正しい編集結果) '// ErrId=0/1/3/5 : 同じパターンで編集し直された電話番号 '// 〃 =8 : ハイフン編集した電話番号 '// 〃 =2 : TelCode のまま(未使用局番なので正誤は判断しない) '// 〃 =4/6/9 : 空文字 '// '// ErrId 0:OK, 1:区切り位置不正, 2:未使用局番(固定電話), 3:市内局番1桁目が[0 or 1](固定電話), '// 4:引数不正([数字,ハイフン,括弧]以外がある or 編集パターン不正 or '0'始まりでない or 桁数不足), '// 5:引数不正(局番タイプに応じた桁数と不一致), '// 6:その他のエラー, 8:OK(数字のみ指定), 9:引数未定義(TelCode) '//------------------------------------------------------------------------------- Public Function ValidateTelephone(ByVal TelCode As String) As TelephoneStruct Dim Result As TelephoneStruct '// 返却値 Dim ResultFormat As TelephoneStruct '// FormatTelephoneの返却値 Dim ResultFormat2 As TelephoneStruct '// 携帯電話(3-3-5桁区切り編集の再取得用) Result = InitTelephone() ResultFormat = InitTelephone() ResultFormat2 = InitTelephone() Dim TelNumber As String '// ハイフン,括弧除去(数字のみ) Dim EditType As Integer '// 厳密なチェックは FormatTelephone の結果と比較して行なうので '// 下記のパターンチェックでは桁数については曖昧で構わない('0'始まりのみチェックする) Const cstPattern0 = "^0\d+$" '// 0123456789 Const cstPattern1 = "^0\d+-\d+-\d+$" '// 012-345-6789 Const cstPattern2 = "^0\d+\(\d+\)\d+$" '// 012(345)6789 Const cstPattern3 = "^\(0\d+\)\d+-\d+$" '// (012)345-6789 If (RegExpCheck(TelCode, cstPattern0) = True) Then '// (数字のみ) 0123456789 '// 数字のみ指定 ⇒ 編集のみ行って比較検証は無し ResultFormat = FormatTelephone(TelCode, 1) '// ハイフン編集で固定 Result.TelType = ResultFormat.TelType Result.EditType = 1 Result.TelEdit = ResultFormat.TelEdit '// ValidateTephone用エラーコードに差替え Select Case ResultFormat.ErrId Case 0 Result.ErrId = 8 '// OK(数字のみ指定) Case 1 Result.ErrId = 2 '// 未使用局番(固定電話番号) Case 2 Result.ErrId = 3 '// 市内局番1桁目が[0 or 1](固定電話) Case 3 Result.ErrId = 4 '// 桁数不足(数字が10桁未満) Case 4 Result.ErrId = 5 '// 局番タイプに応じた桁数と不一致 Case Else Result.ErrId = 6 '// その他のエラー End Select ValidateTelephone = Result Exit Function ElseIf (RegExpCheck(TelCode, cstPattern1) = True) Then '// EditType:1 012-345-6789 EditType = 1 Result.EditType = 1 ElseIf (RegExpCheck(TelCode, cstPattern2) = True) Then '// EditType:2 012(345)6789 EditType = 2 Result.EditType = 2 ElseIf (RegExpCheck(TelCode, cstPattern3) = True) Then '// EditType:3 (012)345-6789 EditType = 3 Result.EditType = 3 Else '// [数字,ハイフン,括弧]以外がある or 編集パターン不正 or '0'始まりでない Result.ErrId = 4 Result.TelEdit = TelCode ValidateTelephone = Result Exit Function End If '// FormatTelephone 用に[ハイフン,括弧]を除去して「数字のみ」にする TelNumber = Replace(TelCode, "-", "") TelNumber = Replace(TelNumber, "(", "") TelNumber = Replace(TelNumber, ")", "") ResultFormat = FormatTelephone(TelNumber, EditType) '// FormatTelephone で編集し直した結果と比較して検証する '// ErrId で返るのは '// 0:OK, 1:未使用局番(固定電話), 2:市内局番1桁目が[0 or 1](固定電話) '// 3:引数不正(TelCode: 数字が10桁未満), '// 4:引数不正(TelCode: 局番タイプの桁数と不一致) '// 下記状態は既にチェック済なので、その値が返ることは無い '// 3:引数不正(TelCode: ['0'始まりの数字]以外) '// 6:引数不正(EditType) '// 9:引数未定義(TelCode/EditType) Result.TelType = ResultFormat.TelType Result.TelEdit = ResultFormat.TelEdit '// ValidateTephone用エラーコードに差替え Select Case ResultFormat.ErrId Case 0 '// FormatTelephoneでOK ⇒ 正しい電話番号 If (TelCode = ResultFormat.TelEdit) Then Result.ErrId = 0 '// OK (区切り位置も正しい) Else If (ResultFormat.TelType = 2) Then '// 携帯電話(070/080/090) '// 携帯電話の場合、別の区切り方[3-3-5 桁]で再チェック ResultFormat2 = FormatTelephone(TelNumber, EditType + 3) If (TelCode = ResultFormat2.TelEdit) Then '// OK (3-3-5桁で一致) Result.ErrId = 0 Result.TelEdit = ResultFormat2.TelEdit Result.EditType = EditType + 3 Else Result.ErrId = 1 '// 区切り位置不正 End If Else '// 携帯電話 以外 Result.ErrId = 1 '// 区切り位置不正 End If End If Case 1 Result.ErrId = 2 '// 未使用局番(固定電話番号) Result.TelEdit = TelCode '// ResultFormat.TelEdit(=TelNumber)なので入力値に差し替える Case 2 Result.ErrId = 3 '// 市内局番1桁目が[0 or 1](固定電話) Case 3 Result.ErrId = 4 '// 桁数不足(数字が10桁未満) Case 4 Result.ErrId = 5 '// 局番タイプに応じた桁数と不一致 Case Else Result.ErrId = 6 '// その他のエラー End Select ValidateTelephone = Result End Function '//------------------------------------------------------------------------------- '// 電話番号のハイフン編集 ( FormatTelephone ) '// '// TelCode -- 半角数字文字列[ 0-9 ], 10 or 11桁(先頭'0'固定) '// 固定電話/携帯電話などの電話番号 '// '// EditType -- 数値 '// 1or4: 0AB-CDE-FGHJ , 2or5: 0AB(CDE)FGHJ , 3or6: (0AB)CDE-FGHJ '// 携帯電話のみ、[3-4-4 桁]で区切る⇒1〜3 , [3-3-5 桁]で区切る⇒4〜6 '// '// 返却値 -- {TelType, EditType, TelEdit, ErrId} の連想配列 '// TelType 1:固定電話(10桁), 2:携帯電話(070/080/090,11桁), 3:着信課金(0120,10桁), '// 4:着信課金(0800,11桁), 5:IP電話(050,11桁), 6:M2M(020x,11桁,x≠4), '// 7:ポケベル(0204,11桁), 8:FMC(0600,11桁), 9:情報料徴収(0990,10桁), '// 10:統一番号(0570,10桁), -1:other '// '// EditType 1or4: 0AB-CDE-FGHJ, 2or5: 0AB(CDE)FGHJ, 3or6: (0AB)CDE-FGHJ, 9:other '// '// TelEdit 編集された電話番号 '// ErrId=0/2/4 : 編集された電話番号 '// 〃 =1 : TelCode の内容のまま '// 〃 =3/6/9 : 空文字 '// '// ErrId 0:OK, 1:未使用局番(固定電話), 2:市内局番1桁目が[0 or 1](固定電話), '// 3:引数不正(TelCode: ['0'始まりの数字]以外 or 10桁未満), '// 4:引数不正(TelCode: 局番タイプに応じた桁数と不一致) '// 6:引数不正(EditType), 9:引数未定義(TelCode/EditType) '//------------------------------------------------------------------------------- Public Function FormatTelephone(ByVal TelCode As String, ByVal EditType As Integer) As TelephoneStruct Dim Result As TelephoneStruct '// 返却値 Dim ResultType As TelephoneStruct '// GetTypeTelephone 返却値 Result = InitTelephone() ResultType = InitTelephone() Const cstTelPattern = "^0\d{9,}$" '// '0'始まりの数字文字列(10桁以上) '// ['0'始まりの数字文字列(10桁以上)]のチェック '// (番号翻訳(GetTypeTelephone)後に完全な桁数チェックを行なう。ここでは10桁未満のみNG) If (RegExpCheck(TelCode, cstTelPattern) = False) Then Result.ErrId = 3 FormatTelephone = Result Exit Function End If If ((EditType >= 1) And (EditType <= 6)) Then Result.EditType = EditType Else FormatTelephone = Result Exit Function End If ResultType = GetTypeTelephone(TelCode) '// 番号翻訳して電話番号の種別と桁区切り情報を取得する '// ErrId で返るのは '// 0:OK, 1:未使用局番(固定電話), 2:市内局番1桁目が[0 or 1](固定電話) '// 下記状態は既にチェック済なので、その値が返ることは無い '// 3:電話番号種別が不明(桁数不足で番号翻訳未了)← 10桁以上なので未了は無い '// 8:引数不正(TelCode: ['0'始まりの数字]以外) '// 9:引数未定義(TelCode) Result.TelType = ResultType.TelType Result.ErrId = ResultType.ErrId If (ResultType.ErrId = 1) Then '// 未使用局番(固定電話) Result.TelEdit = TelCode Else '// 0:OK or 2:市内局番1桁目が[0 or 1](固定電話) If ((ResultType.TelType = 2) And (EditType >= 4)) Then '// 携帯電話(070/080/090)で[3-3-5 桁区切り, 0x0-CDE-FGHJK]を指定された場合 Result.TelEdit = InsertSeparator(TelCode, EditType, 3, 3) Else '// 携帯電話(3-4-4桁区切り)を含め、他は返却値で区切りパターンが得られる '// 固定電話では[市外局番桁数/市内局番桁数/加入者番号桁数(4)]が得られる If (ResultType.Size2 = 0) Then '// 固定電話で、市内局番なし [ 0ABCDE-FGHJ ] (現在、この地域は存在しない) Result.TelEdit = Left(TelCode, 6) & "-" & Mid(TelCode, 7) Else Result.TelEdit = InsertSeparator(TelCode, EditType, ResultType.Size1, ResultType.Size2) End If End If If (Len(TelCode) <> ResultType.SizeAll) Then Result.ErrId = 4 '// 桁数エラー(局番タイプに応じた桁数と不一致) End If End If FormatTelephone = Result End Function Private Function InsertSeparator _ (ByVal TelCode As String, ByVal EditType As Integer, _ ByVal Size1 As Integer, ByVal Size2 As Integer) As String Dim Result As String Dim EditCode1 As String Dim EditCode2 As String Dim EditCode3 As String EditCode1 = Left(TelCode, Size1) '// 1st section :固定電話では市外局番(先頭'0') EditCode2 = Mid(TelCode, (Size1 + 1), Size2) '// 2nd section :固定電話では市内局番 EditCode3 = Mid(TelCode, (Size1 + Size2 + 1)) '// 3rd section :固定電話では加入者番号(末尾まで取り出す) Select Case EditType Case 1, 4 '// 0AB-CDE-FGHJ Result = EditCode1 & "-" & EditCode2 & "-" & EditCode3 Case 2, 5 '// 0AB(CDE)FGHJ Result = EditCode1 & "(" & EditCode2 & ")" & EditCode3 Case 3, 6 '// (0AB)CDE-FGHJ Result = "(" & EditCode1 & ")" & EditCode2 & "-" & EditCode3 End Select InsertSeparator = Result End Function '//------------------------------------------------------------------------------- '// 電話番号タイプの取得 ( GetTypeTelephone ) '// '// TelCode -- 半角数字文字列(2桁以上, 先頭'0'固定) '// 固定電話/携帯電話などの電話番号(途中までの内容でも可) '// '// 返却値 -- {TelType, SizeAll, Size1, Size2, Size3, ErrId} の連想配列 '// TelType 1:固定電話(10桁), 2:携帯電話(070/080/090,11桁), 3:着信課金(0120,10桁), '// 4:着信課金(0800,11桁), 5:IP電話(050,11桁), 6:M2M(020x,11桁,x≠4), '// 7:ポケベル(0204,11桁), 8:FMC(0600,11桁), 9:情報料徴収(0990,10桁), '// 10:統一番号(0570,10桁), -1:other '// '// SizeAll ErrId=0/2 : TelType に応じた電話番号の桁数(10 or 11, Size1〜3の合計値) '// ErrId=1/3/8/9 : 0 '// '// Size1-3 ErrId=0/2 : TelType に応じた電話番号の区切り桁数(Size1 には先頭'0'含む) '// ErrId=1/3/8/9 : 0 '// (携帯電話(TelType=2)は[3-4-4 桁区切り]のみで返す) '// '// ErrId 0:OK, 1:未使用局番(固定電話), 2:市内局番1桁目が[0 or 1](固定電話), '// 3:電話番号種別が不明(桁数不足で番号翻訳未了) '// 8:引数不正(TelCode: ['0'始まりの数字]以外), 9:引数未定義(TelCode) '//------------------------------------------------------------------------------- Public Function GetTypeTelephone(ByVal TelCode As String) As TelephoneStruct Dim Result As TelephoneStruct '// 返却値 Result = InitTelephone() Dim AreaCodeLength As Integer Dim CityCodeLength As Integer Dim CityCode1 As String '// 市内局番の1桁目 Dim idx As Integer Dim cnt As Integer Dim num As Integer Dim LinkValue As Integer Dim TelType As Integer Const cstTelPattern = "^0\d+$" '// '0'始まりの数字文字列(桁数制限なし) '// ( 1)固定電話 10桁 [ 桁区切りは番号翻訳結果に拠る ] '// ( 2)携帯電話 11桁 [ 0x0-CDEF-GHJK , 070/080/090 ] '// ( 3)着信課金 10桁 [ 0120-DEF-GHJ ] '// ( 4)着信課金 11桁 [ 0800-DEF-GHJK ] '// ( 5)IP電話 11桁 [ 050-CDEF-GHJK ] '// ( 6)M2M 11桁 [ 020-CDE-FGHJK ] '// ( 7)ポケベル 11桁 [ 020-4DE-FGHJK ] '// ( 8)FMC 11桁 [ 0600-DEF-GHJK ] '// ( 9)情報料代理徴収 10桁 [ 0990-DEF-GHJ ] '// (10)全国統一番号 10桁 [ 0570-DEF-GHJ ] '// SizeInfo [SizeAll, Size1, Size2, Size3] Dim SizeInfo As Variant SizeInfo = Array(Array(0, 0, 0, 0), Array(10, 0, 0, 0), Array(11, 3, 4, 4), _ Array(10, 4, 3, 3), Array(11, 4, 3, 4), Array(11, 3, 4, 4), _ Array(11, 3, 3, 5), Array(11, 3, 3, 5), Array(11, 4, 3, 4), _ Array(10, 4, 3, 3), Array(10, 4, 3, 3)) '// ['0'始まりの数字文字列(桁数制限なし)]のチェック If (RegExpCheck(TelCode, cstTelPattern) = False) Then Result.ErrId = 8 GetTypeTelephone = Result Exit Function End If '// ※ 番号翻訳テーブルをソースコード内に直に収録しているので '// jQuery による JSONファイルの読み込み処理は必要ない。 '// 番号翻訳テーブルから局番情報(市外局番の桁数 or [携帯番号 等]のTelType情報)を取得する。 '// [TelCode]の長さが[局番桁数 未満]も受け入れているので『番号翻訳 途中』でのループ終了(TelType= -1)もある。 idx = 0 TelType = -1 AreaCodeLength = 0 cnt = 2 '// VBA では文字位置は 1オリジン(Aコードは2桁目, Eコードは6桁目) Do While ((cnt <= 6) And (cnt < Len(TelCode))) '// 番号翻訳テーブルはA〜Eコードの5段 num = CInt(Mid(TelCode, cnt, 1)) '// 電話番号の2桁目以降(1桁目は'0')を順次取り出す LinkValue = getAreaCodeArrayElement(idx, num) If (LinkValue = 0) Then '// 番号翻訳 終了(固定電話 未使用局番) TelType = 1 AreaCodeLength = 0 Exit Do ElseIf (LinkValue < 0) Then '// 番号翻訳 終了 If (LinkValue > -100) Then '// 固定電話の市外局番桁数(符号反転値) 実際の収録値[ -2 〜 -5 ] TelType = 1 AreaCodeLength = LinkValue * (-1) '// 市外局番 桁数決定(先頭の "0" 含む) Else '// 携帯電話 等のTelType値(符号反転値 - 100) 実際の収録値[ -102 〜 -110 ] TelType = (LinkValue * (-1)) - 100 End If Exit Do Else '// プラス値 idx = LinkValue '// 検索継続(収録値は NextIndex) End If cnt = cnt + 1 Loop '// TelType に応じた桁区切りを設定する '// 固定電話(TelType=1)では市外局番桁数(AreaCodeLength)に従って設定する '// Size1 の値は[先頭'0'含む] Result.TelType = TelType Select Case TelType Case -1 '// 電話番号種別が不明(桁数不足で番号翻訳未了) Result.ErrId = 3 Case 1 '// 固定電話 If (AreaCodeLength = 0) Then '// 未使用 局番 Result.ErrId = 1 ElseIf (AreaCodeLength = 6) Then '// 市内局番なし [ 0ABCDE-FGHJ ] (現在、この地域は存在しない) Result.ErrId = 0 Result.SizeAll = 10 Result.Size1 = 6 Result.Size2 = 0 Result.Size3 = 4 Else CityCodeLength = 6 - AreaCodeLength '// 10 - AreaCodeLength - 4(加入者番号) If (Len(TelCode) < (AreaCodeLength + 1)) Then '// [TelCode]が市内局番の桁位置までないので市内局番適否の判定不可⇒ OK で返す Result.ErrId = 0 Else '// FormatTelephone から呼ばれる場合は 10桁以上なので必ず判定可能 CityCode1 = Mid(TelCode, (AreaCodeLength + 1), 1) '// 市内局番 1桁目 If ((CityCode1 = "0") Or (CityCode1 = "1")) Then Result.ErrId = 2 '// 市内局番1桁目に0/1は割り当てられない Else Result.ErrId = 0 '// OK End If End If Result.SizeAll = 10 Result.Size1 = AreaCodeLength Result.Size2 = CityCodeLength Result.Size3 = 4 End If Case Else '// TelType = 2〜10, SizeInfoテーブルから桁情報を設定する Result.ErrId = 0 '// OK Result.SizeAll = SizeInfo(TelType)(0) Result.Size1 = SizeInfo(TelType)(1) Result.Size2 = SizeInfo(TelType)(2) Result.Size3 = SizeInfo(TelType)(3) End Select GetTypeTelephone = Result End Function