Home » Dictionaryオブジェクトの使い方 » 単語と単語の個数一覧をExcelに出力するWordマクロ

単語と単語の個数一覧をExcelに出力するWordマクロ

対象：Word2003, Word2007, Word2010

文書に含まれる単語の一覧をExcelに出力するWordマクロをご紹介しました。

ここまでくると、その単語が文書の中でいくつ含まれるのかも知りたくなります。

そんなマクロをご紹介しておきます。

［スポンサードリンク］

まず、アクティブなドキュメントで、指定された語句の個数をカウントするFunctionプロシージャから。

▼指定された語句の数を数えるFunctionプロシージャ

Function CountWord(WordWantToCount As String) As Long

　Dim cnt As Long

　With ActiveDocument.Range(0, 0).Find
　　.Text = WordWantToCount
　　Do While .Execute
　　　cnt = cnt + 1
　　Loop
　End With

　CountWord = cnt

End Function

Do While ～ Loop文の条件に、FindオブジェクトのExecuteメソッドを指定しておくことで、
　With ActiveDocument.Range(0, 0).Find
　　.Text = WordWantToCount
　　Do While .Execute
Trueである限り = 指定された語句がみつかるかぎり、ループします。

そのループの中で数を数えて
　　　cnt = cnt + 1

その個数をFunctionプロシージャの戻り値としています。
　CountWord = cnt

上記のFunctionプロシージャを、単語と個数をカウントするマクロの中で利用します。

Sub 単語と個数をExcelに書き出す()

　Dim dic As Object　' Scripting.Dictionary
　Dim wrd As Word.Range
　Dim txt As String
　Dim xls As Object
　Dim keys As Variant
　Dim items As Variant
　Dim i As Long

' 連想配列に単語と個数を登録
　On Error Resume Next
　Set dic = CreateObject("Scripting.Dictionary")
　For Each wrd In ActiveDocument.Words
　　txt = Trim(wrd.Text)
　　dic.Add txt, CountWord(txt)
　Next wrd
　On Error GoTo 0

　keys = dic.keys
　items = dic.items

' Excelに単語と個数を書き出し
　Set xls = CreateObject("Excel.Application")
　xls.Visible = True
　With xls
　　.SheetsInNewWorkbook = 1
　　.Workbooks.Add
　　For i = 0 To dic.Count - 1
　　　.Cells(i + 1, "A").Value = "'" & keys(i)
　　　.Cells(i + 1, "B").Value = items(i)
　　Next i
　End With

　Set xls = Nothing
　Set dic = Nothing

End Sub

基本的なロジックは、既にご紹介している文書に含まれる単語をExcelに出力するマクロと同じです。

スペースの扱いの関係で、同じ単語とみなして欲しいのに別の単語とみなされてしまうのを防ぐために、連想配列に単語を登録する処理でTrim関数をはさんで
　　txt = Trim(wrd.Text)
きれいにしてやってから

連想配列に、単語と個数を登録しています。
　　dic.Add txt, CountWord(txt)
ここで先のFunctionプロシージャを呼んでいます。

連想配列に登録した単語（keys）と個数（items）を、Excelに出力しやすくするために、それぞれをVariant型の変数に格納して配列にしてから
　keys = dic.keys
　items = dic.items

ExcelをCreateObjectして
　Set xls = CreateObject("Excel.Application")

Excelを表示し
　xls.Visible = True

シートを1枚に設定し
　　.SheetsInNewWorkbook = 1

ブックを追加して
　　.Workbooks.Add

単語をA列に
　　　.Cells(i + 1, "A").Value = "'" & keys(i)
個数をB列に
　　　.Cells(i + 1, "B").Value = items(i)
書き出しています。

関連語句