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

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

質問者からの補足コメント

• 補足質問どうもありがとうございます。
  今、№1の方の提示して下さったコードで問題なく動作することを確認しました。これから、教えていただいたコードの内容について考えていきたいと思っています。
  ①4桁の数字に関しては半角前提で問題ないです。
  ②4桁の数字（西暦）は必ずあります。
  上記方法であれば余談の方法は必要なさそうです。ありがとうございます。
  実際の使用としては、翌年のファイルを作成し、ファイル名に含まれている年を翌年のものに変更する、という使い方です。
  現在は、20○○年のある文字の位置を予め指定しておいて、翌年ファイルを作成する方法をとっているのですが、これだと、ファイル名を変えられた時に変更が必要になり不便なので、正規表現を使用するともう少し確実にできると思ったのです。ただい、年以外の数字が１つは確実に入ることは決まっています。4桁の数字は20○○年のみです。
  補足させてすみません。

  No.2の回答に寄せられた補足コメントです。 補足日時：2018/09/08 11:55

No.4 ベストアンサー 回答者： tatsu99 回答日時： 2018/09/08 13:05

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

この回答へのお礼

どうもありがとうございます。
試してみると、問題なく動作しました。
動作をみながら、行っている事がなんとか理解できました。
全てを括弧でくくることで、ファイル名の変更が容易にできそうです。
このコードを元に、さらに他の方の意見やコードを参考にして自分で変更してみました。
自分が提示したコードと真逆のコードですが、こちらの方がよいですね。
あと基本は、半角入力しており全角は使わないのですが、万が一の入力ミスを考え全角もいれました。全角だと１を加算できないとのことだったのですが、今回のケースでは全角・半角混在でも１を加算することができました。


Sub FindNumberRegExp5()
Dim reg As New RegExp '正規表現クラスオブジェクト
Dim str As String
Dim result As Variant
str = Range("A1")
'全角・半角の４桁の数字を抽出
reg.Pattern = "(.*)([2２][0０][0-5０-５][0-9０-９])(.*)"
result = reg.Replace(str, "$2") '$2はreg.Pattern内の（）の順番を指定。Replaceで（）内の文字と置き換えている。
'Debug.Print result
'もし1個以上抽出できてたら
If result <> "" Then
' 4桁の数字を書き出す
Range("A2").Value = result
Range("A3").Value = result + 1
End If
End Sub

お礼日時：2018/09/09 02:24

No.3 回答者： fakeflake 回答日時： 2018/09/08 10:16

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

9999とかもマッチしてしまうことになりますから。

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

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

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …

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

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

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

この回答へのお礼

ご指摘どうもありがとうございます。
個人的にはおっしゃる通り基本半角入力を行うようにしていますが、複数の人が使用する場合、気にしない人やその辺りの知識がない人もいるため難しい所です。
今回のケースで実験してみた所、全角・半角数字混在でも問題なく動作することがわかりました。データの内容によっては、判定で別物と判定されたりと問題を起こすと想定できるので、そのようなケースの時は、半角置換の方法を試してみようと思います。
西暦取り出しの、20[01][0-9] の指定は、他の方のコードに応用できるので、ありがたく使わせていただきます。
どうもありがとうございました。

お礼日時：2018/09/09 02:06

No.2 回答者： tatsu99 回答日時： 2018/09/08 09:20

補足要求です。

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

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

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

No.1 回答者： siffon9 回答日時： 2018/09/08 03:09

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

せっかく正規表現を使用するのですから、「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

この回答へのお礼

どうもありがとうございました。
思い通りに動作しました。
何とか書いている内容がなんとなく理解できました。

お礼日時：2018/09/09 01:58