ワードの文中の日付抽出

質問

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

回答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.11

HohoPapa

OKの場合はスルーするようにしました。
むろんスルーすると、チェック対象から外れたのか、
ＯＫなのかが区別できません。
もし、スルーしたくなったら、

　　　　'MsgBox "OK:" & _
　　　　'　 Format(GetDay(Selection.Range.Text), "GGGE年M月D日") & _
　　　　'　 Right(Selection.Range.Text, 3)
を
　　　　MsgBox "OK:" & _
　　　　　 Format(GetDay(Selection.Range.Text), "GGGE年M月D日") & _
　　　　　 Right(Selection.Range.Text, 3)
と書き換えてください。

動作パターンを３つ用意しました。
一長一短がありますので、フィットするものを使ってください。
（選択しないパターンをコメントアウトしてください。）

パターン１
令和x年を考慮しないコードです。

パターン２
令和x年を考慮したコードですが、
ワードを開いて実行したときに、若干醜いです。

パターン３
令和x年を考慮したコードで、
ワードを開いて実行したときに見やすいものの、
9月3日(金)といった文字列がワード文章の先頭に来ると
それは検査の対象から漏れます。
以下のコードは、このパターン３のコードです。

Option Explicit

Const MyNen = 3　　'年が省略されている場合に見なす令和の年

Sub DateCheck()

　ActiveDocument.Bookmarks("\StartOfDoc").Select
　With Selection.Find

　　'パターン1
　　'.Text = "([0-9| ]{1,2}月)([0-9| ]{1,2}日)([\(|（)]?[(\)|）])"

　　'パターン2
　　'.Text = "*([0-9| ]{1,2}月)([0-9| ]{1,2}日)([\(|（)]?[(\)|）])"

　　'パターン3
　　.Text = "?????([0-9| ]{1,2}月)([0-9| ]{1,2}日)([\(|（)]?[(\)|）])"

　　.MatchFuzzy = False
　　.MatchWildcards = True
　　Do While .Execute

　　　If Format(GetDay(Selection.Range.Text), "aaa") = _
　　　　 Left(Right(Selection.Range.Text, 2), 1) Then
　　　　'ＯＫの場合
　　　　'MsgBox "OK:" & _
　　　　'　 Format(GetDay(Selection.Range.Text), "GGGE年M月D日") & _
　　　　'　 Right(Selection.Range.Text, 3)

　　　'ＮＧの場合
　　　Else
　　　　MsgBox "★ＮＧ：" & _
　　　　　 Format(GetDay(Selection.Range.Text), "GGGE年M月D日") & _
　　　　　 Right(Selection.Range.Text, 3)
　　　End If

　　Loop
　End With
　ActiveDocument.Bookmarks("\StartOfDoc").Select

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

補足

度々ですが、さっそく使わせていただいていますので、ご報告します。
OKをスルーするのかどうかは、そのときによって使い分けています。ありがとうございます。

パターン3を使用していたのですが、◯月○日(曜日)～■月■日(曜日) という記載があった場合、～以降にある日付は認識されなくなってしまいました。
パターン1では、問題なくチェックに引っ掛かったのですが、年を考慮していただいたからでしょうか？

回答No.10

HohoPapa

>OKの場合は、メッセージがでないようにして、
>NGだけメッセージを出すことは可能ですか？
どうするか悩んだところでした。出ないようにします。

また、
令和x年がある場合に対応できていないことを
私が私を許さないので対応します。

さらに、
曜日の前後の()が全角、半角混在なこと、
月、日の1文字目に半角スペースが混じることにも
それぞれ対応します。

都合、クローズせず、のんびりと待つ、
または、他の識者の方のコメントをお待ちください。

補足

NGメッセージの件、全角半角、スペースなど、ありがとうございます。
月の前に半角スペースは、今の時点でチェック対象になっているようです。

すみません。。
令和x年がNGとなった箇所は、令和4年のところでした。(2021年ではないから、OKエラーということですよね。)

都合、クローズせず、のんびりと待つ、
または、他の識者の方のコメントをお待ちください。
→ありがとうございます。
お言葉に甘え、このままにさせていただきます。
感謝いたします。

回答No.9

HohoPapa

>チェック用にあらかじめ半角スペースを消す等で、対応してもいいかと思っています。
回答No.8 に示したコードは
半角スペースが含まれていてもチェックするようにしました。
確認してみてください。

>年の記載は、和暦となります。
令和なのか、令なのかＲなのか、Rなのかがわからないので
また、半角スペースの有無もありますので、例示してほしいのです。

補足

すみません。ありがとうございます。

和暦の場合は、以下のようになります
(西暦ではでてこない。令和をRや令などに略した形もなし)。

令和3年10月 5日(火)
令和3年12月24日(金)
令和4年2月1日(火)
令和4年 2月 1日(火)

カッコは、半角全角混在してます。

回答No.8

HohoPapa

日付の文字列に年があったりなかったりするケースは
ちょっと作りこみが必要そうなので
>全体の比率でいうと、ほぼ年の記載がない日付がほとんどです。
の言葉に甘え、
年の含まれる文字列は考慮しない（※）コードとしてみました。
試してみてください。

下記コードが、過日と同じで、WORDにセットするマクロです。

Option Explicit

Sub DateCheck()

　ActiveDocument.Bookmarks("\StartOfDoc").Select
　With Selection.Find

　　.Text = "([0-9| ]{1,2}月)([0-9| ]{1,2}日)\(?\)"
　　.MatchFuzzy = False
　　.MatchWildcards = True
　　Do While .Execute
　　　MsgBox isDateOk(Selection.Range.Text)
　　Loop
　End With

End Sub

Function isDateOk(strDate As String) As String

　Dim wk1 As String
　Dim wk2 As String
　Dim ChkDate As Date

　Const MyNen = "2021年"

　wk1 = Left(strDate, Len(strDate) - 3)

　wk1 = Replace(wk1, " ", "")

　On Error GoTo badDate
　wk2 = Format(DateValue(MyNen & wk1), "yyyy年m月d日(aaa)")
　On Error GoTo 0

　If MyNen & Replace(strDate, " ", "") = wk2 Then
　　isDateOk = "OK:" & strDate
　Else
　　isDateOk = "★ＮＧ：" & strDate
　End If

　Exit Function
badDate:
　isDateOk = "★文法ＮＧ：" & strDate
　Exit Function
End Function

※年が含まれ、かつ、2021年でない場合、ほぼ必ず"★ＮＧ："の表示になります。
ワードの文章を開いて実行すれば、どの部分のチェック結果なのかを確認できます。
期待と異なるところがあるようなら指摘してください。
対応できるかもしれません。

また、コードの中にある
　Const MyNen = "2021年"　の記述は、
新たな年になったら書き換える必要があります。
あるいは、コード上に埋め込まず
実行日からこの部分を求めるコードも考えられます。

補足

ありがとうございます。
すごいです！感動してしまいました。
ワードを開きながらチェックしました。
説明していただいたとおり、令和と記載のあるところは、NGになりました(そこだけ目でみるので問題なしです)。
和暦表示がないものは、どんどんチェックが進むのと、メッセージボックスに表示されるのも見やすかったです(*^^*)。
2021年を書き換えれば、違う年にも対応可能ということですね。すごいです。
期待と異なるということは全くないのですが、ちなみに、OKの場合は、メッセージがでないようにして、NGだけメッセージを出すことは可能ですか？

回答No.7

HohoPapa

>月や日付が1桁の箇所は、体裁を整えるために前に半角スペースが入っている箇所もあり
この体裁のままチェックするということになりますか？
それとも、体裁を修正するように促すことを期待していますか？

>年については、ワード本文中、今年の日付については年の記載はなく、
>来年だと年の記載があります。
和暦ですか西暦ですか？
サンプル提示してみてください。

補足

追加の回答、感謝いたします。

>月や日付が1桁の箇所は、体裁を整えるために前に半角スペースが入っている箇所もあり
この体裁のままチェックするということになりますか？
それとも、体裁を修正するように促すことを期待していますか？

→資料自体は、半角スペースありが正しいものとなるので、チェック用にあらかじめ半角スペースを消す等で、対応してもいいかと思っています。

>年については、ワード本文中、今年の日付については年の記載はなく、
>来年だと年の記載があります。
和暦ですか西暦ですか？
サンプル提示してみてください。

→年の記載は、和暦となります。

回答No.6

imogasi

既に、ご回答が出ているが、興味を覚えてやってみた。
ワードの場合は、エクセルのようには、日付箇所の発見がうまく行かず、文字列のパターン頼りしかない？と思う。英語式の表現Ｊａｎなどだと下記では！お手上げです。
下記は平成、昭和、令和の日付に限る。年・月・日の数字の範囲（月だと月数字１－１２までなど）のチェックは省いている。月や日の数字、などは、半角全角どちらでもよい。１数字の場合、０付きかどうかもどちらでもよい。正規表現利用的でなく、ワイルドカード利用レベルにとどめてある。
下記の部分などが、参考になるかな。
Selection.Range.HighlightColorIndex = wdPink
wd = Weekday(DateValue(Selection.Range))
MsgBox DateValue(Selection.Range) & " " & WeekdayName(wd)
ーーー
ワードの標準モジュールに
Sub test01()
moj = Array("", "平成*年*月*日", "昭和*年*月*日", "令和*年*月*日")
'ActiveDocument.Content.Select
'ActiveDocument.StoryRanges(wdMainTextStory).Select
For i = 1 To 3
ActiveDocument.StoryRanges(wdMainTextStory).Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
’MsgBox "AA"
With Selection.Find
.ClearFormatting
MsgBox moj(i)
.Text = moj(i)
.MatchFuzzy = False
.MatchWildcards = True

.Execute

Do While .Execute
Selection.Range.HighlightColorIndex = wdPink
wd = Weekday(DateValue(Selection.Range))
MsgBox DateValue(Selection.Range) & " " & WeekdayName(wd)
Loop
End With
Next
End Sub
テストデータ数不足であるため、もし引っかかったら、本件無視してください。

回答No.5

kkkkkm

No3の一部訂正

その行の日付と曜日を取り出します。
↑
だと元の記載にある曜日のままというイメージになるので
以下に訂正です。
その行の日付と日付に対応した正しい曜日を書き出します。

お礼

ありがとうございます！
試してみます。

回答No.4

HohoPapa

◯月◯日(曜日)
が
9月3日(金)
9月13日(月)
11月3日(水)
11月15日(月)
といった形式で入力されている。
ということであれば、
ワード文書の先頭から、この形式の文字列を次々と特定することが可能です。

添付のマクロは、wordで使うマクロのコードで
実行すると
"C:\work\Checktest.txt"
が作成できます。

作成できるようなら、
エクセルの関数でもVBAでも
あるいは、ワードのマクロの中でも
チェックすることが可能です。

まずは、
"C:\work\Checktest.txt"
を作成できるかどうか、
さらに、先のコメントにもありますが
年をどのように考えればいいのか教えてください。

その後、チェックするコードあるいは関数を紹介できると思います。

Option Explicit

Sub findPattern()

Open "C:\work\Checktest.txt" For Output As #1

ActiveDocument.Range(0, 0).Select

With Selection.Find
.Text = "([0-9]{1,2}月)([0-9]{1,2}日)\(?\)"
.MatchFuzzy = False
.MatchWildcards = True

Do While .Execute
Print #1, Selection.Range.Text
Loop
End With

Close #1

End Sub

補足

ありがとうございます。
Checktest.txt 作成されました。
ただ、月や日付が1桁の箇所は、体裁を整えるために前に半角スペースが入っている箇所もあり、そのような箇所は認識されませんでした(スペースを消したら認識されました)。
年については、ワード本文中、今年の日付については年の記載はなく、来年だと年の記載があります。
幅は前年度～今年度～来年度 くらいです。
全体の比率でいうと、ほぼ年の記載がない日付がほとんどです。

回答No.3

kkkkkm

年が今年でよろしければ、文章をエクセルのA列に全てコピペして以下のマクロを実行するとC列以降にその行の日付と曜日を取り出します。
0月0日から99月99日まで認識しますが、日付としてみなせないものは取り出しません。

Sub test()

Dim Reg As Object
Dim mMatches As Object
Dim mPattern As String
Dim i As Long, j As Long

mPattern = "[0-9][0-9]月[0-9][0-9]日|" & _
"[0-9]月[0-9][0-9]日|" & _
"[0-9][0-9]月[0-9]日|" & _
"[0-9]月[0-9]日"

Set Reg = CreateObject("VBScript.RegExp")
Reg.Pattern = mPattern
Reg.Global = True
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Set mMatches = Reg.Execute(StrConv(Cells(i, "A").Text, vbNarrow))
If mMatches.Count > 0 Then
For j = 0 To mMatches.Count - 1
If IsDate(mMatches.Item(j).Value) Then
Cells(i, "C").Offset(0, j).Value = mMatches.Item(j).Value & Format(mMatches.Item(j).Value, "(aaa)")
End If
Next
End If
Next
End Sub

回答No.2

kkkkkm

◯月◯日(曜日)

年が無ければ曜日は確定できないと思います。