セルの検索や置換を正規表現で行うには
Excelの標準の検索機能はワイルドカードでの検索は可能ですが、正規表現での検索を行うことはできません。
無いものはしょうがないので作るしかありません。
で、正規表現での検索と置換になりますので、VBScriptのRegExpクラスを利用することになります。
RegExpクラスを使うための事前設定
正規表現を利用するにはVBScriptのRegExpクラスを利用します。CreateObject関数で書くこともできますが、参照設定をした方が便利です。
正規表現の参照設定の方法は次の通りです。
- VBAの画面でツールメニュー→参照設定 を選択します。
- 参照設定ダイアログで「Microsoft VBScript Regular Expressions 5.5」にチェックを付けます。
- OKボタンを押して閉じます。
これで設定は終わりです。
正規表現でのセル検索と置換を行う関数
以下のFindCellRegExp関数は指定されたシートにあるセルの中から、正規表現の検索パターンに一致するセルを検索します。
見つかった場合はそのセルを選択します。見つからなかった場合はメッセージを出力します。
引数が５つあり、1.検索対象ワークシート、2.検索パターン、3.大文字小文字の区別設定、4.検索と置換のどちらであるか、5.置換文字列、を指定します。
4番目と5番目は省略可になっており、省略時は検索のみを行い置換は行いません。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 |
'// 引数1：ワークシート '// 引数2：検索パターン '// 引数3：大文字小文字の区別（True：区別しない、False：区別する） '// 引数4：検索と置換のどちらであるか（True：検索、False：置換） '// 引数5：置換文字列 Sub FindCellRegExp(a_sht As Worksheet, a_sPattern As String, a_bIgnoreCase As Boolean, Optional a_bFindReplace As Boolean = True, Optional a_sReplace As String = "") Dim reg As New RegExp '// 正規表現クラス Dim iLen '// 検索一致文字列長 Dim r As Range '// 選択セル範囲の処理中の１セル Dim i '// ループカウンタ Dim bResult As Boolean '// 検索結果 Dim rPre As Range '// アクティブセルより上のセルで一致したセル Dim rFind As Range '// 検索一致セル '// 検索文字列が未設定の場合 iLen = Len(a_sPattern) If iLen = 0 Then Exit Sub End If '// 正規表現の条件設定 reg.Global = True '// 文字列の最後まで検索（True：する、False：しない） reg.IgnoreCase = a_bIgnoreCase '// 大文字小文字の区別（True：する、False：しない） reg.Pattern = a_sPattern '// 検索する正規表現パターン '// セル範囲を１セルずつループ For Each r In a_sht.UsedRange '// セル文字列から正規表現での検索を行う bResult = reg.Test(r.Value) '// 検索に一致しなかった場合 If bResult = False Then GoTo CONTINUE End If '// 以下検索に一致した場合 Debug.Print r.Address(False, False) '// 上セルでの検索一致で見つかったセルがまだ無い場合 If rPre Is Nothing Then '// 現在見つかっているセルを設定 Set rPre = Range(r.Address) End If '// ループのセルがアクティブセルより上にある場合 If (r.Row < ActiveCell.Row) Then GoTo CONTINUE '// ループのセルがアクティブセルと同じ行だけど右にある場合 ElseIf (r.Row = ActiveCell.Row) And (r.Column <= ActiveCell.Column) Then GoTo CONTINUE '// ループのセルがアクティブセルより右下にある場合 Else '// 検索一致セルが未設定の場合 If rFind Is Nothing Then Set rFind = Range(r.Address) End If End If CONTINUE: Next '// 見つかった場合 If Not rFind Is Nothing Then rFind.Select '// アクティブセルより上側で見つかった場合 ElseIf Not rPre Is Nothing Then rPre.Select '// 見つからなかった場合 Else Call MsgBox("検索対象が見つかりません", vbExclamation, "正規表現検索") Exit Sub End If '// 置換の場合 If a_bFindReplace = False Then '// アクティブセルの文字列を置換 ActiveCell.Value = reg.Replace(ActiveCell.Value, a_sReplace) End If End Sub |
コード説明
処理内容はほとんどはコメントに書いてあるので、補足が必要な点について説明します。
この関数がやりたいことは、アクティブセルを起点として、右下に向かって検索を行い見つかればそのセルを検索一致とみなします。右下側にない場合はシートに入力されている一番左上のセルから検索して最初に見つかったセルを検索一致セルとみなします。ただ、コードはそのようには書いておらず、UsedRangeプロパティを使って入力されているセル範囲を左上から右下に向かって全セルでの文字列検索を行い、あとで選択すべきセルがどれなのかを判定しています。
これには２つ理由があります。
１つはシートの中でどこが検索一致しているかを一覧で見られるようにしたかったためで、イミディエイトウィンドウに検索一致セルのアドレスを出力しています。一覧化しておけば、配列やDictionaryで使ったり、通常のExcelの検索機能のようにフォームで実装した場合にリストボックスなどで選択＋ジャンプなどに使えるため、そのように実装しました。ここではフォームは使ってませんけど。
もう１つの理由は、検索処理とセル選択処理と置換処理を分離させたかったためです。分離させておけば検索処理と置換処理を共用化しやすくなります。まあこれは好みの問題もあるので。
で、全セルをループしながら、アクティブセルより上側で見つかったセルと下側で見つかったセルで、下側で見つかったセルがあればそちらを選択し、なければ上側のセルを選択し、どちらもなければメッセージを出すようにしています。
あとは、引数で置換を行う指定がされている場合は、検索で見つかったセルに対して文字列の置換を行っています。
使い方
上の関数の使い方は引数に渡して実行するだけです。
以下のコードでは検索時に引数を省略して書く方法と、置換時の方法を書いています。
|
1 2 3 4 5 6 7 8 9 10 11 |
Sub FindCellRegExpTest() Dim sPattern As String sPattern = "(\[.*)" sPattern = "(\d\d)" '// 検索 ' Call FindCellRegExp(ActiveSheet, sPattern, True) '// 置換 Call FindCellRegExp(ActiveSheet, sPattern, True, False, "$1@@@") End Sub |
ブックの全シートを対象にするには
このマクロは指定されたシートを対象にしていますが、ブックの全シートに対して正規表現での検索や置換を行いたい場合があります。
その場合は、この関数内で行っているセルの選択処理は削除した方がよいでしょう。というのも、次に検索一致になるのが次のシートの場合があるためです。シートをまたがった処理を行うためには、セルの選択はブック全体の検索が終わったあとに行うように変更し、rPre変数とrFind変数は関数を抜けたあとも保持できるような仕組みにするのが望ましいでしょう。
気が向いたら、追記もしくは別で紹介するかも、しないかも、です。