以下のマクロをWordのVBAエディタに貼り付けて実行
Sub CountRevisionChars()
Dim doc As Document
Dim rev As Revision
Dim totalChars As Long
Dim insertChars As Long
Dim deleteChars As Long
Set doc = ActiveDocument
totalChars = 0
insertChars = 0
deleteChars = 0
For Each rev In doc.Revisions
' 挿入された文字のカウント
If rev.Type = wdRevisionInsert Then
insertChars = insertChars + Len(rev.Range.Text)
End If
' 削除された文字のカウント
If rev.Type = wdRevisionDelete Then
deleteChars = deleteChars + Len(rev.Range.Text)
End If
Next rev
totalChars = insertChars + deleteChars
MsgBox "■ 修正履歴の文字数カウント結果" & vbCrLf & _
"挿入文字数: " & insertChars & " 文字" & vbCrLf & _
"削除文字数: " & deleteChars & " 文字" & vbCrLf & _
"合計: " & totalChars & " 文字"
End Sub
VBAの起動手順
- Alt + F11 でVBAエディタを開く
- 挿入 → 標準モジュール をクリック
- 上記コードを貼り付け
- F5 で実行
英語の単語数(1バイト文字)もカウントしたい場合のVBAコード
Sub CountRevisionCharsAndWords()
Dim doc As Document
Dim rev As Revision
Dim insertChars As Long
Dim deleteChars As Long
Dim insertWords As Long
Dim deleteWords As Long
Set doc = ActiveDocument
For Each rev In doc.Revisions
' 挿入のカウント
If rev.Type = wdRevisionInsert Then
insertChars = insertChars + Len(rev.Range.Text)
insertWords = insertWords + rev.Range.Words.Count
End If
' 削除のカウント
If rev.Type = wdRevisionDelete Then
deleteChars = deleteChars + Len(rev.Range.Text)
deleteWords = deleteWords + rev.Range.Words.Count
End If
Next rev
MsgBox "■ Revision Count Results" & vbCrLf & _
"--- Insertions ---" & vbCrLf & _
"Characters: " & insertChars & vbCrLf & _
"Words: " & insertWords & vbCrLf & _
"--- Deletions ---" & vbCrLf & _
"Characters: " & deleteChars & vbCrLf & _
"Words: " & deleteWords & vbCrLf & _
"--- Total ---" & vbCrLf & _
"Characters: " & (insertChars + deleteChars) & vbCrLf & _
"Words: " & (insertWords + deleteWords)
End Sub
出力イメージ
■ Revision Count Results
— Insertions —
Characters: 120
Words: 24
— Deletions —
Characters: 85
Words: 17
— Total —
Characters: 205
Words: 41
スペースを除いた文字数が欲しい場合
Len() の部分を以下に変更するとスペースを除外できます。
Len(Replace(rev.Range.Text, " ", ""))
コメント