🔧
ExtractNumbers
ユーティリティ文字列から数字のみを抽出する
テキストと数値が混在するセルから数値部分だけを抽出するVBAマクロです。正規表現（RegExp）またはループによる文字種判定で数字文字だけを取り出し、数値として別セルに出力します。「123個」「¥5,000」「TEL:03-1234-5678」のような書式から純粋な数値を取り出す処理に最適で、データクレンジングや集計前の前処理として頻繁に使用されます。内部ではVBScript.RegExpオブジェクトに\d+のパターンを設定してマッチした数字列を抽出しており、正規表現エンジンを使うことでループによる1文字判定より高速かつ簡潔にコードを書けます。ExtractTextと対になる関係にあり、数値部分と文字列部分をそれぞれ別のマクロで抽出すれば、混在データの完全な構造化が実現します。手作業での転記に比べて桁の見間違いといった入力ミスも根絶できます。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： 数字を抽出する文字列が含まれるセル範囲を選択して実行
🎯 活用シーン
- ✓「売上: 1,500,000円」のようなテキストから金額数値のみを抽出して集計
- ✓電話番号フィールドからハイフンを除いた数字のみを取り出す
- ✓コード番号に混入した余分な文字を除去して純粋なIDに整形
- ✓問い合わせフォームの自由記述欄に混在する金額情報を抽出し、概算集計を自動化したいとき
- ✓スキャンしたPDFから変換した住所データに紛れ込んだ郵便番号だけを抽出したいとき
💡 実装のヒント
- ▸VBScript.RegExpオブジェクトで\d+パターンにマッチした数字を抽出できます
- ▸IsNumeric関数を使った1文字ずつのループでも数字のみを抽出できます
- ▸カンマや小数点も含めたい場合は抽出ロジックをカスタマイズします
- ▸カンマ区切りの数値（1,234,567など）を正しく数値化したい場合は、抽出後にReplace関数でカンマを除去してからCLng/CDblで変換してください。
- ▸マイナス値や小数点を含む数値を抽出したい場合は、正規表現パターンを拡張する必要があります。
💻 VBAコード
' ExtractNumbers
' -----------------
' Macro Name: ExtractNumbers
' Description: 文字列から数字のみを抽出する
' Parameters: なし
' Returns: なし
' Usage: 数字を抽出する文字列が含まれるセル範囲を選択して実行
' -----------------
Sub ExtractNumbers()
Dim cell As Range
Dim resultWs As Worksheet
Dim outputRow As Long
On Error GoTo ErrorHandler
If TypeName(Selection) <> "Range" Then
MsgBox "セル範囲を選択してください。", vbExclamation
Exit Sub
End If
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 originalText As String
Dim normalizedText As String
Dim extractedNum As String
Dim i As Long
originalText = CStr(cell.Value)
normalizedText = StrConv(originalText, vbNarrow)
extractedNum = ""
For i = 1 To Len(normalizedText)
Dim ch As String
ch = Mid(normalizedText, i, 1)
If ch >= "0" And ch <= "9" Then
extractedNum = extractedNum & ch
End If
Next i
resultWs.Cells(outputRow, 1).Value = cell.Address
resultWs.Cells(outputRow, 2).Value = originalText
resultWs.Cells(outputRow, 3).NumberFormat = "@"
resultWs.Cells(outputRow, 3).Value = extractedNum
outputRow = outputRow + 1
End If
Next cell
resultWs.Columns("A:C").AutoFit
resultWs.Select
MsgBox "数字抽出が完了しました。", vbInformation
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub