XX月XX日(曜)～XX月XX日(曜)
指摘を受け気づきましたが、このケースも、
文章の先頭(厳密には５文字目以前)から始まる場合に
検査対象にならないのと同じ理由で、後者側が検査対象になりません。
いくつかヒットしないケースがあるかもしれないと危惧していましたが、
このケースには気づきませんでした。
また、検査してＯＫだった時にも結果を表示したい場合と
表示したくない場合とがあるとのことなので、
上記対応も含めコードを書き直してみました。
これなら、
XX月XX日(曜)～XX月XX日(曜) の場合も、
文章の先頭から始まる場合も
対応しているはずです。試してみてください。
なお、XX月XX日(曜)の文字列の途中で明示的に改行している場合は
検査対象になりません。
Option Explicit
Const MyNen = 3 '年が省略されている場合に見なす令和の年(1～99)
Sub DateCheck()
Dim SPos As Long
Dim EPos As Long
Dim WorkStr As String
Dim rc As Integer
rc = MsgBox("OKの場合も検査結果を表示しますか？", vbYesNo + vbQuestion, "確認")
ActiveDocument.Bookmarks("\StartOfDoc").Select
With Selection.Find
.Text = "([0-9| ]{1,2}月)([0-9| ]{1,2}日)([\(|（)]?[(\)|）])"
.MatchFuzzy = False
.MatchWildcards = True
Do While .Execute
SPos = Selection.Range.Start
EPos = Selection.Range.End
If SPos < 5 Then '※
SPos = 0
Else
SPos = SPos - 5 '※
End If
WorkStr = ActiveDocument.Range(SPos, EPos).Text
If Format(GetDay(WorkStr), "aaa") = _
Left(Right(WorkStr, 2), 1) Then
If rc = vbYes Then
'ＯＫの場合
MsgBox "OK:" & _
Format(GetDay(WorkStr), "GGGE年M月D日") & Right(WorkStr, 3)
End If
Else
'ＮＧの場合
MsgBox "★ＮＧ：" & _
Format(GetDay(WorkStr), "GGGE年M月D日") & Right(WorkStr, 3)
End If
Loop
End With
ActiveDocument.Bookmarks("\StartOfDoc").Select
'※の５は、"令和x年"、"令和xx年"を想定した文字数
End Sub
'//------------------------------------------------
Function GetDay(InText As String) As Date '年月日を取得
Dim y As Long
Dim m As Long
Dim d As Long
y = GetY(InText)
m = GetM(InText)
d = GetD(InText)
GetDay = DateSerial(y + 2018, m, d)
End Function
'//------------------------------------------------
Function GetD(InText As String) As Long '日を取得
Dim i As Long
If IsNumeric(Left(Right(InText, 6), 1)) = False Then
GetD = Val(Left(Right(InText, 5), 1))
Else
GetD = Val(Left(Right(InText, 6), 2))
End If
End Function
'//------------------------------------------------
Function GetM(InText As String) As Long '月を取得
If Left(Right(InText, 7), 1) = "月" Then
If IsNumeric(Left(Right(InText, 9), 1)) = False Then
GetM = Val(Left(Right(InText, 8), 1))
Else
GetM = Val(Left(Right(InText, 9), 2))
End If
End If
If Left(Right(InText, 6), 1) = "月" Then
If IsNumeric(Left(Right(InText, 8), 1)) = False Then
GetM = Val(Left(Right(InText, 7), 1))
Else
GetM = Val(Left(Right(InText, 8), 2))
End If
End If
End Function
'//------------------------------------------------
Function GetY(InText As String) As Long '令和暦で年を取得
Dim i As Long
Dim FromY As Long
Dim ToY As Long
Dim wkY As Date
For i = 11 To 15
If Left(Right(InText, i), 2) = "令和" Then
FromY = i - 2
Exit For
End If
Next i
For i = 8 To 10
If Left(Right(InText, i), 2) = "年" Then
ToY = i + 1
Exit For
End If
Next i
wkY = Val(Left(Right(InText, FromY), FromY - ToY))
If wkY = 0 Then
GetY = MyNen
Else
GetY = wkY
End If
End Function
お礼
何度も本当にありがとうございます！ 実際の会議資料で使わせていただいています。 ～で記載の部分も、チェック対象となりました。 ありがとうございます！！