やりたいこと
特定ファイルの全てのセルを対象に形態素毎に分離を行い、結果を別のシートに格納する。
環境情報
- 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 に相当)できます。
以上。