📊 Excel VBA Top100
🔧

ValidatePhoneNumber

ユーティリティ

選択範囲の電話番号形式を検証する

🎬 デモGIF準備中

📖 使い方

  1. VBAエディタを開く(Alt + F11)
  2. モジュールを挿入(挿入 > モジュール)
  3. 下記VBAコードをコピー&ペースト
  4. ブック上で実行(Alt + F8 でマクロ選択)
💡 実行例: 電話番号が入力されたセル範囲を選択して実行

💻 VBAコード

' ValidatePhoneNumber
' -----------------
' Macro Name: ValidatePhoneNumber
' Description: 選択範囲の電話番号形式を検証する
' Parameters: なし
' Returns: なし
' Usage: 電話番号が入力されたセル範囲を選択して実行
' -----------------

Sub ValidatePhoneNumber()
    Dim cell As Range
    Dim validCount As Long
    Dim invalidCount As Long
    Dim outputRow As Long
    Dim resultWs As Worksheet
    Dim phonePattern As String

    On Error GoTo ErrorHandler

    If TypeName(Selection) <> "Range" Then
        MsgBox "セル範囲を選択してください。", vbExclamation
        Exit Sub
    End If

    phonePattern = "^[0-9\-\(\)\+ ]+$"

    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 phoneNum As String
            phoneNum = CStr(cell.Value)

            If IsValidPhone(phoneNum, phonePattern) Then
                resultWs.Cells(outputRow, 1).Value = cell.Address
                resultWs.Cells(outputRow, 2).Value = phoneNum
                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 = phoneNum
                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 IsValidPhone(phone As String, pattern As String) As Boolean
    Dim regEx As Object

    If Len(phone) < 7 Or Len(phone) > 20 Then
        IsValidPhone = False
        Exit Function
    End If

    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = pattern
    regEx.IgnoreCase = True

    IsValidPhone = regEx.Test(phone)
End Function