ワードの文中の日付抽出

質問

会議資料をワードで作成しています。
文章の中に、日付(と曜日)が記載してあり、その日付と曜日が正しいかのチェックを、自動で行うことは可能でしょうか？
抽出して比較とか、作業用にエクセルに張り付けるとか、少し手作業があるのは構いません。
今は、目で見て確認しているため、精度向上と時間短縮する方法が知りたく、質問いたしました。

回答No.12

HohoPapa · ベストアンサー

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

お礼

何度も本当にありがとうございます！
実際の会議資料で使わせていただいています。
～で記載の部分も、チェック対象となりました。
ありがとうございます！！

回答No.1

kkkkkm

日付と曜日の関係が正しいかどうかということでしたら
日付をエクセルにコピーして
A1に日付があればB1にでも
=TEXT(A1,"aaaa")
とすればその日付にたいする曜日が表示されます。

補足

ご回答ありがとうございます！
ワードは、15ページくらいあり、文章の中に日付が入っています。
一つずつセルにコピーしていくとなると、かなりの数になるので、
できれば、一気に文章全体でコピーして、そのあと確認するか、ワードから日付だけを一括で抽出(◯月◯日(曜日)という記載で統一)し、まとめて確認できたら…と思っています。

ワードからエクセルに一気にコピーすると、ワードの1文章単位でエクセルの1セルにコピーされますが、1文章内に2回、日付が出てくる場合もあります。