正規表現を使う

VBScript の正規表現モジュールを使うと良いらしい。

参照

http://officetanaka.net/excel/vba/tips/tips38.htm

呼び出し方

Dim re As Object
Set re = CreateObject("VBScript.RegExp")

プロパティ

名前	説明	Default値
Property	正規表現で使用するパターンを登録する。
IgnoreCase	小文字と大文字を区別するかどうかの真偽値。	False
Global	文字列全体を検索するかどうかの真偽値。	False

メソッド

名前	説明
Test	正規表現オブジェクトを使ったマッチングを行う。一致したら True を返す。
Replace	正規表現オブジェクトを使った置換を行う。
Execute	Matchオブジェクトの集合(Matches コレクション)を返します。

Matches コレクションのプロパティ

名前	説明
Count	Match オブジェクトの個数。
Item	Matches( 1 ) と同じ目的で使用するプロパティ。

Match オブジェクトのプロパティとメソッド

名前	説明
FirstIndex	最初にマッチングに成功した位置を返します。
Length	パターンマッチした文字列の長さ
Value	パターンマッチした文字列

サンプル

サンプル 1

選択セルの Value をチェックし、Value が数字のみで構成されていたら太字・赤字に変更する。

Sub RegExpTest1()
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "^[1-9][0-9]+$"

    Dim rng As Range
    For Each rng In Selection
        With rng
            If re.Test(.Text) Then
                .Font.ColorIndex = 3
                .Font.Bold = True
            End If
        End With
    Next
End Sub

サンプル 2

選択セルの Value をチェックし、数字のみ全て抜き出してE列に順次表示する。

Sub RegExpTest2()
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "[0-9]+"
    re.Global = True

    Dim rng As Range
    Dim matches As Object
    Dim ct As Integer
    Dim r As Integer
    
    r = 1
    For Each rng In Selection
        Set matches = re.Execute(rng)
        
        ct = 0
        Do While ct < matches.Count
            Cells(r, 5) = matches(ct).Value
            ct = ct + 1
            r = r + 1
        Loop
    Next
End Sub