チェック種類 | チェック内容 |
---|---|
郵便番号のチェック | 「半角数字3桁+ハイフン+半角数字4桁」になっているかをチェックしています。 半角数字でない文字を使用したり、桁数違い、ハイフンの位置違いはエラーになります。 |
電話番号のチェック | 電話番号は国内の国際電話を除く電話番号に相当するチェックです。 数字は全て半角で市外局番が0始まりで2桁から5桁、市内局番は1~4桁、後の電話番号が4桁としており、局番間のセパレータはハイフンまたはカッコです。 |
メールアドレスチェック | メールアドレスは半角英数字(大文字、小文字は問わず)および許されている記号と途中に半角「@」が入り、 以降のドメイン半角英数字(大文字、小文字は問わず)および許されている記号で構成され、 最後が「.com」「.jp」のようにドットの後半角英数字2~4文字で終わるようにチェックします。 |
全角英数カナチェック | サンプルは「カナ氏名」なので英数は不要かもしれませんが、外国籍者の対応があるかもしれません。 ここでは全角の英数カタカナおよび一部の記号以外はエラーとなるようにチェックします。 |
'***************************************************************************************************
' 住所録の新規登録(正規表現利用サンプル) UF_JUSYOROKU(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
' Microsoft VBScript Regular Expressions 5.5
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'12/01/16(1.00)新規作成
'20/02/29(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "住所録新規登録"
Private Const g_cnsBlank As String = ""
'---------------------------------------------------------------------------------------------------
' メールアドレス用正規表現パターン
Private Const g_cnsRegPatternEMAIL As String = "^[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}$"
' 郵便番号用正規表現パターン
Private Const g_cnsRegPatternZIPCODE As String = "^[0-9]{3}-[0-9]{4}$"
' 電話番号用正規表現パターン(国内のみ)
Private Const g_cnsRegPatternTELNO As String = "^0[0-9]{1,4}[-(][0-9]{1,4}[-)][0-9]{4}$"
' 全角英数カナ用正規表現パターン
Private Const g_cnsRegPatternKANA As String = "^[ァ-ーA-Za-z0-9-:'・.]+$"
'---------------------------------------------------------------------------------------------------
Private g_objWbk As Workbook ' 対象ワークブック
Private g_objSh As Worksheet ' 対象シート
Private g_objRegExp As New RegExp ' 正規表現エンジン
'***************************************************************************************************
' ■■■ コントロールイベント ■■■
'***************************************************************************************************
'* 処理名 :BTN_OK_Click
'* 機能 :登録ボタンイベント(Click)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub BTN_OK_Click()
'-----------------------------------------------------------------------------------------------
' フォーム内容チェック
If FP_CheckForm Then
' シートへの登録
Call GP_UpdateSheet
' フォームクリア
Call GP_ClearForm
End If
End Sub
'***************************************************************************************************
' ■■■ フォームイベント ■■■
'***************************************************************************************************
'* 処理名 :UserForm_Activate
'* 機能 :フォームイベント(Activate)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Activate()
'-----------------------------------------------------------------------------------------------
' フォームクリア
Call GP_ClearForm
End Sub
'***************************************************************************************************
'* 処理名 :UserForm_Initialize
'* 機能 :フォームイベント(Initialize)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Initialize()
'-----------------------------------------------------------------------------------------------
' ワークブック側オブジェクトの取得
Set g_objWbk = ThisWorkbook
Set g_objSh = g_objWbk.Worksheets("住所録")
End Sub
'***************************************************************************************************
' ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 :GP_ClearForm
'* 機能 :フォームクリア
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_ClearForm()
'-----------------------------------------------------------------------------------------------
With Me
.TXT_SEI.Text = g_cnsBlank ' 漢字姓
.TXT_MEI.Text = g_cnsBlank ' 漢字名
.TXT_K_SEI.Text = g_cnsBlank ' カナ姓
.TXT_K_MEI.Text = g_cnsBlank ' カナ名
.TXT_YUBIN.Text = g_cnsBlank ' 〒
.TXT_JUSYO1.Text = g_cnsBlank ' 住所①
.TXT_JUSYO2.Text = g_cnsBlank ' 〃 ②
.TXT_TEL.Text = g_cnsBlank ' 電話
.TXT_FAX.Text = g_cnsBlank ' FAX
.TXT_KEITAI.Text = g_cnsBlank ' 携帯
.TXT_EMAIL.Text = g_cnsBlank ' eメール
End With
End Sub
'***************************************************************************************************
'* 処理名 :FP_CheckForm
'* 機能 :フォーム入力内容チェック
'---------------------------------------------------------------------------------------------------
'* 返り値 :チェック成否(Boolean)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_CheckForm() As Boolean
'-----------------------------------------------------------------------------------------------
Dim strMSG As String ' エラーメッセージ
Dim strAddMessage As String ' 追加メッセージWork
' 漢字姓
If FP_GetTextFromComtrol(TXT_SEI) = g_cnsBlank Then
Call GP_AppendMSG(strMSG, "「氏名(姓)」が入力されていません。")
End If
' 漢字名
If FP_GetTextFromComtrol(TXT_MEI) = g_cnsBlank Then
Call GP_AppendMSG(strMSG, "「氏名(名)」が入力されていません。")
End If
' カナ姓
If FP_CheckRegExp(TXT_K_SEI, strAddMessage, g_cnsRegPatternKANA) >= 1 Then
Call GP_AppendMSG(strMSG, "「カナ(姓)」" & strAddMessage)
End If
' カナ名
If FP_CheckRegExp(TXT_K_MEI, strAddMessage, g_cnsRegPatternKANA) >= 1 Then
Call GP_AppendMSG(strMSG, "「カナ(名)」" & strAddMessage)
End If
' 〒
If FP_CheckRegExp(TXT_YUBIN, strAddMessage, g_cnsRegPatternZIPCODE) >= 1 Then
Call GP_AppendMSG(strMSG, "「〒」" & strAddMessage)
End If
' 住所①
If FP_GetTextFromComtrol(TXT_JUSYO1) = g_cnsBlank Then
Call GP_AppendMSG(strMSG, "「住所①」が入力されていません。")
End If
' 電話(ブランクは許可)
If FP_CheckRegExp(TXT_TEL, strAddMessage, g_cnsRegPatternTELNO) >= 2 Then
Call GP_AppendMSG(strMSG, "「電話」" & strAddMessage)
End If
' FAX(ブランクは許可)
If FP_CheckRegExp(TXT_FAX, strAddMessage, g_cnsRegPatternTELNO) >= 2 Then
Call GP_AppendMSG(strMSG, "「FAX」" & strAddMessage)
End If
' 携帯(ブランクは許可)
If FP_CheckRegExp(TXT_KEITAI, strAddMessage, g_cnsRegPatternTELNO) >= 2 Then
Call GP_AppendMSG(strMSG, "「携帯」" & strAddMessage)
End If
' eメール(ブランクは許可)
If FP_CheckRegExp(TXT_EMAIL, strAddMessage, g_cnsRegPatternEMAIL) >= 2 Then
Call GP_AppendMSG(strMSG, "「eメール」" & strAddMessage)
End If
'-----------------------------------------------------------------------------------------------
' チェック結果判定
If strMSG <> g_cnsBlank Then
MsgBox strMSG, vbExclamation, g_cnsTitle
FP_CheckForm = False
Else
FP_CheckForm = True
End If
End Function
'***************************************************************************************************
'* 処理名 :GP_UpdateSheet
'* 機能 :シートへの登録
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:本処理は追加登録のみ
'***************************************************************************************************
Private Sub GP_UpdateSheet()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
With g_objSh
' フィルタ抽出状態を解除
If .FilterMode Then .ShowAllData
' 登録行を判定(最終行の次行) ※全行とも埋まっている判断は省略
lngRow = .Range("$A$" & .Rows.Count).End(xlUp).Row + 1
' フォーム上の内容を転記
.Cells(lngRow, 1).FormulaR1C1 = "=ROW()-2" ' №
.Cells(lngRow, 2).Value = Trim(TXT_SEI.Text) ' 漢字姓
.Cells(lngRow, 3).Value = Trim(TXT_MEI.Text) ' 漢字名
.Cells(lngRow, 4).Value = Trim(TXT_K_SEI.Text) ' カナ姓
.Cells(lngRow, 5).Value = Trim(TXT_K_MEI.Text) ' カナ名
.Cells(lngRow, 6).Value = Trim(TXT_YUBIN.Text) ' 〒
.Cells(lngRow, 7).Value = Trim(TXT_JUSYO1.Text) ' 住所①
.Cells(lngRow, 8).Value = Trim(TXT_JUSYO2.Text) ' 〃 ②
.Cells(lngRow, 9).Value = Trim(TXT_TEL.Text) ' 電話
.Cells(lngRow, 10).Value = Trim(TXT_FAX.Text) ' FAX
.Cells(lngRow, 11).Value = Trim(TXT_KEITAI.Text) ' 携帯
.Cells(lngRow, 12).Value = Trim(TXT_EMAIL.Text) ' eメール
End With
End Sub
'***************************************************************************************************
' ■■■ 共通サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 :FP_CheckRegExp
'* 機能 :正規表現チェック
'---------------------------------------------------------------------------------------------------
'* 返り値 :チェック結果(Integer) ※0=正常、1=未入力、2=値不正
'* 引数 :Arg1 = TextBox(Object)
'* Arg2 = 追加メッセージ(String) ※Ref参照
'* Arg3 = 正規表現パターン(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_CheckRegExp(ByRef objTextBox As MSForms.TextBox, _
ByRef strAddMessage As String, _
ByVal strPattern As String) As Integer
'-----------------------------------------------------------------------------------------------
Dim strText As String ' 項目テキスト
FP_CheckRegExp = 0
strAddMessage = g_cnsBlank
' テキストボックス値取得(Trim)
strText = FP_GetTextFromComtrol(objTextBox)
If strText = g_cnsBlank Then
strAddMessage = "が入力されていません。"
FP_CheckRegExp = 1
Else
' 郵便番号の形式チェック(正規表現)
With g_objRegExp
.Pattern = strPattern
.IgnoreCase = True
If Not .Test(strText) Then
strAddMessage = "の形式が不正です。"
FP_CheckRegExp = 2
End If
End With
End If
End Function
'***************************************************************************************************
'* 処理名 :FP_GetTextFromComtrol
'* 機能 :テキストボックス値取得(Trim)
'---------------------------------------------------------------------------------------------------
'* 返り値 :取得結果(String)
'* 引数 :Arg1 = TextBox(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_GetTextFromComtrol(ByRef objTextBox As MSForms.TextBox) As String
'-----------------------------------------------------------------------------------------------
FP_GetTextFromComtrol = Trim("" & objTextBox.Text)
End Function
'***************************************************************************************************
'* 処理名 :GP_AppendMSG
'* 機能 :メッセージ追加
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = メッセージ本体(String) ※Ref参照
'* Arg2 = 追加メッセージ(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2012年01月16日
'* 作成者 :井上 治
'* 更新日 :2020年02月29日
'* 更新者 :井上 治
'* 機能説明:改行を付加してメッセージを追加
'* 注意事項:
'***************************************************************************************************
Private Sub GP_AppendMSG(ByRef strMSG As String, strADDMSG As String)
'-----------------------------------------------------------------------------------------------
If strMSG <> "" Then strMSG = strMSG & vbCrLf
strMSG = strMSG & strADDMSG
End Sub
'----------------------------------------<< End of Source >>----------------------------------------