【ワードマクロ】単語の出現回数をカウント：使用例２選

ワードマクロで、単語の出現回数をカウントするVBAコードをご紹介します。

このページのマクロコードは、コピペで使えます。
ぜひお試しください😉

単語の出現回数をカウント
単語の出現回数をカウント（複数の単語）

単語の出現回数をカウント

以下のVBAを実行すると、特定文字の登場回数をカウントしてメッセージボックスに表示します。


Sub 単語の出現回数を数える()

    Dim myRange As Range
    Dim wP As Long
    Dim wE As Long
    Dim LastwE As Long
    Dim LastwP As Long
    Dim WordCnt As Long
    Dim GetWord As String

    '文書の最後のページを取得
    LastwP = ActiveDocument.Range.Information(wdNumberOfPagesInDocument)

    ActiveDocument.Range(0, 0).Select
    Set myRange = ActiveDocument.Range(0, 0)
    
    GetWord = "ビデオ"
    
    '検索条件
    With myRange.Find
        .Text = GetWord
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = True
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
        .MatchWildcards = False
     
        Do While .Execute
                           
            With myRange
                wE = .End
                wP = .Information(wdActiveEndPageNumber)
            End With
           
            '1つ前の文字位置と、今回の文字位置を比較
            If wE < LastwE Or wE = LastwE Then
                Exit Do
            End If
            
            WordCnt = WordCnt + 1
            LastwE = wE
            
        Loop
        
    End With
    
    MsgBox "「" & GetWord & "」 の出現回数：" & WordCnt & "個"

End Sub

マクロ実行前

ワードファイル内に「ビデオ」という文字が、何回登場しているかをカウントします。

「ビデオ」という文字は、文章内と表内にある状態です。

検索したいキーワードは、[GetWord = "ビデオ"] に設定します。

マクロ実行後

メッセージボックスに単語の出現回数を表示します。

単語の出現回数をカウント（複数の単語）

以下のVBAを実行すると、複数の単語の登場回数をカウントしてメッセージボックスに表示します。


Sub 複数の単語の出現回数をカウント()

Dim myRange As Range
Dim wE As Long
Dim i As Long
Dim LastwE As Long
Dim LastwP As Long
Dim WordCnt As Long
Dim Target() As Variant
Dim msg As String

    '文書の最後のページを取得
    LastwP = ActiveDocument.Range.Information(wdNumberOfPagesInDocument)

    '文書の先頭を選択
    ActiveDocument.Range(0, 0).Select
    
    '単語を配列に格納
    Target = Array("Word", "クリック", "ビデオ", "Excel")
    
    '配列分ループ
    For i = 0 To UBound(Target)
    
        WordCnt = 0
        LastwE = 0
        wE = 0
        Set myRange = ActiveDocument.Range(0, 0)
    
        '検索条件
        With myRange.Find
            .Text = Target(i)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = True
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
            .MatchFuzzy = False
            .MatchWildcards = False
         
            Do While .Execute
                               
                wE = myRange.End
               
                '1つ前の文字位置と、今回の文字位置を比較
                If wE < LastwE Or wE = LastwE Then
                    Exit Do
                End If
                
                WordCnt = WordCnt + 1
                LastwE = wE
                
            Loop
            
        End With
        
        msg = msg & vbCrLf & "「" & Target(i) & "」 の出現回数：" & WordCnt & "個"
    
    Next i
    
    MsgBox msg

End Sub