2019年11月24日高速版を記事にしました。 文書に含まれる単語を調べるマクロ_並べ替え付き（Collectionオブジェクト）その2
先日の記事「文書に含まれる単語を調べるマクロ（Collectionオブジェクト）」で、Collectionオブジェクトを使った便利なマクロを紹介しました。
これは、Collectionオブジェクトのメンバーをためる際のくせを利用して、重複しない文字列を１つのコレクションとして取得するものでした。
今回は、このCollectionオブジェクトの中の要素（メンバー）を並べ替えるマクロです。
＜目次＞
このマクロでできること
文書内の単語を抽出して、アルファベット順に並べ替えて新規文書に書き出します。
単語は、「半角と全角を区別しない」、かつ「大文字と小文字を区別しない」という条件のもと、重複しないものが抽出されます。
マクロの解説
9行～12行、20行～32行を前回紹介したコードに追記しました。
参考にしたページはこちらの記事です。
Filling A Listbox With Unique Items
こうやってコードを公開していただけるって本当にありがたいですね。
上記の記事では、エクセルのセルに入っている文字列を取得して、並び替えた後にユーザーフォームのリストに書き出すものです。
今回は、Wordに作り替えていますから、現在の文書に記載されている単語を取得して、それを並べ替えた後に新規文書に書き出すような仕組みになっています。
開発背景
前回の記事で紹介したとおり、インストラクターのネタ帳 の管理人でMicrosoft Excel MVPの伊藤潔人さんが先日の記事で「文書に含まれる単語を調べるマクロ 」がもともとのヒントになっています。
伊藤さんの記事を読んだときに真っ先に、並べ替えがしたいと思って、インターネットやVBEのヘルプで探し始めました。
すぐにわかったことは、Dictionaryオブジェクトで並べ替えをするのは難しいらしいということでした。
結局、上記の記事にたどり着いて、並べ替え部分をそのままコードの一部を使わせていただいています。
大きな文書で数千の単語を並べ替えようとすると時間がかかりますけどね。
Excelで並べ替えた方が早い、というご指摘は今回はなしです。Wordで完結することに意味があります（笑）。
それにしても、このコードを公開なさっている方が、Excel用に開発したところが面白いですよね。
並べ替えについては、Excelで新しいシートを開いて、そこにコピペして並べ替えてそれを取得した方が断然早いと思うのですが。
技術の紹介という側面のマクロなのでしょうか。
いろんな事情があると思うので私にはよくわかりませんが、私が無理矢理Wordでこういう作業をしていることも、ほかの方から見たら意味がわからないのだと思いますので同じですか。。。
マクロ
Sub 文書に含まれる単語を書き出すマクロ_並べ替え() '大文字・小文字の区別をしない '全角・半角の区別をしない Dim myDic As New Collection Dim wrd As Range Dim myItem As Variant Dim i As Integer Dim j As Integer Dim Swap1 As Variant Dim Swap2 As Variant On Error Resume Next For Each wrd In ActiveDocument.Words myDic.Add Item:=wrd.text, key:=CStr(wrd.text) Next wrd On Error GoTo 0 'ソートをする For i = 1 To myDic.Count - 1 For j = i + 1 To myDic.Count If myDic(i) > myDic(j) Then Swap1 = myDic(i) Swap2 = myDic(j) myDic.Add Swap1, Before:=j myDic.Add Swap2, Before:=i myDic.Remove i + 1 myDic.Remove j + 1 End If Next j Next i '書き出し With Application.Documents.Add For Each myItem In myDic .Range.InsertAfter myItem & vbCr Next myItem End With End Sub
参考にした記事
文書に含まれる単語を調べるマクロ （インストラクターのネタ帳の記事→Dictionaryオブジェクトを利用）