【ExcelVBA】Word.Applicationを用いてファイル全体の形態素分割を行う

やりたいこと

特定ファイルの全てのセルを対象に形態素毎に分離を行い、結果を別のシートに格納する。

環境情報

• Microsoft Visual Basic for Applications 7.1

やり方

Word文書の新規文書を用意した上で

Set wd = CreateObject("Word.Application")
Set doc = wd.Documents.Add

解析対象のファイル名を取得した上でVBAが書かれているファイルのアクティブシートを取得し

fName = Dir(ThisWorkbook.Path & "\*解析対象のファイル名*.xlsx", vbNormal)
Set tws = ThisWorkbook.ActiveSheet

ファイル全体にて形態素分析をかける。

Do While fName <> ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & fName, ReadOnly:=False)

lastRowNum = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
lastColNum = wb.Sheets(1).Cells(headline_start + 1, Columns.Count).End(xlToLeft).Column
        
For j = 1 To lastColNum
For i = 1 To lastRowNum
 
myval = wb.Sheets(1).Cells(i, j)
wd.Selection.text = myval
        
For wc = 1 To wd.Selection.Words.Count
tws.Cells(k, 1) = wd.Selection.Words(wc).text
k = k + 1
Next wc
doc.Content.Delete

Next i
Next j

wb.Close SaveChanges:=False

End If
fName = Dir()
Loop

以下、補足です。

補足

下記の箇所にてWordの用語分割機能で語句毎に分割したものをアクティブシートに書き足して行っています。

For wc = 1 To wd.Selection.Words.Count
tws.Cells(k, 1) = wd.Selection.Words(wc).text
k = k + 1
Next wc

ただし、このままだと被りなどがそのままシートに表示されるので

Set sortRange = tws.Range("A1:A" & k - 1)
With sortRange
.Sort key1:=tws.Cells(1, 1), order1:=xlAscending, Header:=xlYes
End With
    
sortRange.CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes

上記を実施することでソートした上で重複を削除（sort | uniq に相当）できます。

以上。