ExcelVBAで正規表現を使って年を抽出したい

Question

Excel2013VBAで、正規表現を初めて使用するのですが、A1セルに入力されている「第１回2018年度大会」より、A2セルに「2018」を抽出してA3セルに１をプラスした翌年の「2019」に変更して表示したいと思います。
以下のコードでは、「12018」となってしまいます。
最初の1つ目の数字は抽出しないパターンと「第１回」をずばり指定して抽出しないという両方のやり方を教えていただけると今後の為にありがたいです。
今のコードでは、A2セルに「12018」A3セルに「12019」となってしまい、先頭に余計な1が残っています。
お手数をおかけいたしますが、どうぞ宜しくお願いいたします。

Sub FindNumberRegExp(s, result)
    Dim reg As New RegExp       '正規表現クラスオブジェクト
    
    '全角・半角数字以外を抽出
    reg.Pattern = "[^ 0-9０-９]"
    '文字列の全てを対象
    reg.Global = True
    'reg.Pattern(数字以外の文字)を空文字に置き換える
    result = reg.Replace(s, "")
End Sub


Sub FindNumberCallTest()
    Dim result As Variant
    
    Call FindNumberRegExp(Range("A1"), result)

    Debug.Print result

　　Range("A2").Value = result
　　Range("A3").Value = result + 1
End Sub

tatsu99 · Accepted Answer

No2です。
半角４桁の数字が存在することが保障されるなら、以下のようになります。
\dは[0-9]と同義です。
$1はReplaceメソッドに限り使用可能な変数です。
正規表現が括弧でくくられているとき、マッチ時のそのカッコ内の値を示します。
$1は1番目の()です。
$2は2番目の()です。
$3は3番目の()です。
このケースは()は１つなので$1を使用します。
尚、5桁以上の数値があると、この場合後ろの４桁の数字にマッチします。
12345なら2345を取得します。
12345なら1234を取得したいときは、No1の方の方法を採用してください。
--------------------------------------------------------------------------
Sub FindNumberRegExp2(s, result)
    Dim reg As New RegExp    '正規表現クラスオブジェクト
    '半角の４桁の数字を抽出
    reg.Pattern = ".*(\d{4}).*"
    result = reg.Replace(s, "$1")
End Sub
Sub FindNumberCallTest2()
    Dim result As Variant
    Call FindNumberRegExp2(Range("A1"), result)
    Debug.Print result
    Range("A2").Value = result
    Range("A3").Value = result + 1
End Sub

fakeflake · Answer

あと4桁の数字というのが必ず西暦年を示すものだという決めつけも危険です。9999とかもマッチしてしまうことになりますから。

現実的にはここ最近の出来事が対象になるでしょうから、正規表現としては 20[01][0-9] くらいが無難だと思います。これだと、2000～2019だけがマッチします。ただし5桁以上の数字が混ざっていると誤動作してしまうし、またそれを1つの正規表現で始末するのは現実的ではありません。すでにやっているように、まず数値以外の文字を空白に置き換え、その結果に対してもう一度正規表現検索をかけるようにしないといけません。

それともう1点、全角数字は最初から半角に置換してから処理する方がおそらく無難です。全角半角混在の文字列を相手にするのは、嫌な予感がします。

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_zenkakueisuji.html

それと最後に一つ、検索対象にこう言う文字列があると、これら専用の判定を必要とされるので複雑化します。

2018年3Q全社営業会議
→いきなり西暦年で始まる

サマーフェスタ2017
→西暦年で終わる

tatsu99 · Answer

補足要求です。
No1の方のいう通りで、このようなケースでは、４桁の数字を抽出するのが最も簡単かと思います。
その前提での補足要求ですが、
①４桁の数字は全て半角であることを前提にして良いと思いますが、いかがでしょうか。
それとも、全角と半角が混在した４桁の数字なのでしょうか。
もし、全角がふくまれるなら、抽出した結果に１を加算することはできません。
抽出した結果を半角に変換し、それに１を加算する必要があります。
②A1のなかに検索対象の文字列（４桁の数字）が必ず存在することを前提にした抽出方法で良いのでしょうか。
それとも、含まれない場合も考慮した抽出方法を望んでいるのでしょうか。

余談：
あなたが提示された「最初の1つ目の数字は抽出しないパターン」は、
「1つ目の数字列と２つ目の数字列があれば、２番目の数字列を取り出す」ということになります。（数字列は全角半角が混在する）
本当にこのようなパターンの抽出を望まれているなら、そのコードの提示は可能です。

又、「"第１回"をずばり指定して抽出しない」パターンは、
「"第１回"の後に４桁の数字が続くとき、その４桁の数字を取り出す」ということになります。（4桁の数字は全角半角が混在）
本当にこのようなパターンの抽出を望まれているなら、そのコードの提示は可能です。

siffon9 · Answer

この場合、数字以外を消して取得するという考え方はよろしくないです。
せっかく正規表現を使用するのですから、「4桁の数字」を抽出しましょう

下の例では、resultはMatchesコレクションというオブジェクトになります。
A1セルに書かれた文字列によっては「4桁の数字」が複数抽出される可能性もありますので
そのうち最初の「4桁の数字」を利用します。

余談
パターンを"[0-9０-９]+"にすると
result(0).Value は「第1回」の「1」
result(1).Value は「2018」になります。

Sub FindNumberRegExp(ByVal s As String, ByRef result As Object)
　　Dim reg As Object
　　Set reg = CreateObject("VBScript.RegExp") '正規表現クラスオブジェクト

'4連続する全角・半角数字
　　reg.Pattern = "[0-9０-９]{4}"
　　'文字列の全てを対象
　　reg.Global = True
　　'reg.Pattern(4桁の数字)を全て抽出する
　　Set result = reg.Execute(s)
End Sub

Sub FindNumberCallTest()
　　Dim result As Object

' A!セルの文字列中から、4桁の数字を全て抽出する
　　Call FindNumberRegExp(Range("A1").Value, result)

'もし1個以上抽出できてたら
　　If result.Count > 0 Then
　　　　' 最初に抽出した4桁の数字を書き出す
　　　　Range("A2").Value = result(0).Value
　　　　Range("A3").Value = result(0).Value + 1
　　End If
End Sub

ExcelVBAで正規表現を使って年を抽出したい

No2です。

あと4桁の数字というのが必ず西暦年を示すものだという決めつけも危険です。

補足要求です。

この場合、数字以外を消して取得するという考え方はよろしくないです。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング