VBA によるテキスト処理
こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。
この記事の目次
目的
VBAを始めようとして、とりあえず『VBA』でインターネット検索をすると、『集計作業』、『報告書の作成作業』から始めると良いですよ！と書いてあるWebサイトが多々ありました。（筆者調べ）
そこで、報告書を作成するVBAは既にあるのですが、ソースコードもエクセルも整理されていないので、ここでちょっと整理して１つにまとめてみようと思います。
まとめ方としては、こんな感じでしょうかね。
①ファイル入力
②テキスト処理
③ファイル出力
この記事は、テキスト処理！！
関数
テキスト読み込み
どんな集計作業も報告書作成も元になるファイルがあるわけで、そのファイルを読み込まないと始まりません。ソースコード①
〜テキスト読み込み〜
先ずはファイルパスからテキストを読み込みます。ファイル入力のインターフェースは下の図１の様なインターフェースを想定しています。
'Public Const ShName = "ファイル入力"
'Public Const fld行 = 8
'Public Const fil行 = 11
'Public Const Name列 = 3
'Public Const Path列 = 9
Public Const ShName1 = "メモリ"
Public Const txt行 = 1
Public Const txt列 = 1
Sub ファイルパスリボルブ()
i = fil行
With ThisWorkbook.Worksheets(ShName)
fPath = .Calls(i, Path列).Value
While fPath <> ""
Call テキスト読込(fPath)
' ここに『テキスト処理関数』を追加する
'************************
'************************
i = i + 1
fPath = .Calls(i, Path列).Value
Wend
End With
End Sub
Sub テキスト読込(ByVal fPath)
Dim n As Integer
Dim i As Integer
Dim txtLine As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(fPath) Then
MsgBox "ファイルが存在しません"
Exit Sub
End If
i = txt行
n = FreeFile
Open fPath For Input As #n
Do While Not EOF(n)
Line Input #n, txtLine
ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value = txtLine
i = i + 1
Loop
Close #n
Set FSO = Nothing
End Sub
テキスト処理
上のソースコード①で Excel にテキストを読み込みました。ですが、読み込んだだけでまだ何もしてません。
今、テキストを自然言語だとします。つまり、日本語の文章が書かれているという事です。
かなり Microsoft Word の機能が使えるので、ちょっと処理してみます。
ソースコード②
〜Word出力〜
Microsoft Word の機能を使うために Word をExcel VBA から起動して、テキストを Word に出力してみます。
Function Excel2Word()
Set WdApp = CreateObject("Word.Application")
WdApp.Visible = True
WdApp.documents.Add
i = txt行
txtLine = ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value
While txtLine <> ""
WdApp.Selection.typetext Text:=txtLine
i = i + 1
txtLine = ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value
Wend
Set Excel2Word = WdApp
Set WdApp = Nothing
End Function
ソースコード③
〜文カウント〜
Microsoft Word に出力した文章がどれだけの文で構成されているかをカウントしてみます。
Function 文カウント(ByVal WdApp)
Set Doc = WdApp.ActiveDocument
Set Rng = Doc.Paragraphs(1).Range
i = 0
For Each stc In Rng.Sentences
i = i + 1
Next
文カウント = i
End Function
ソースコード④
〜単語カウント〜
今度は Microsoft Word に出力した文章がどれだけの単語で構成されているかをカウントしてみます。ただし、このコードだと文章を構成する単語数をカウントするので、単語の重複は無視した単語数になります。
Function 単語カウント(ByVal WdApp)
Set Doc = WdApp.ActiveDocument
Set Rng = Doc.Paragraphs(1).Range
i = 0
For Each wrd In Rng.Words
i = i + 1
Next
単語カウント = i
End Function
使い方
ソースコード①で書いた『ファイルパスリボルブ』に記載しておいた "ここに『テキスト処理関数』を追加する" という箇所にテキスト処理関数を記載します。
Sub ファイルパスリボルブ()
i = fil行
With ThisWorkbook.Worksheets(ShName)
fPath = .Calls(i, Path列).Value
While fPath <> ""
Call テキスト読込(fPath)
' ここに『テキスト処理関数』を追加する
'************************
Set WdApp = Excel2Word()
文数 = 文カウント(WdApp)
単語数 = 単語カウント(WdApp)
'************************
i = i + 1
fPath = .Calls(i, Path列).Value
Wend
End With
End Sub
コメント
テキスト出力処理が未実装なので、このままではテキスト処理の結果が確認出来ない状態です。
早くファイル出力の内容をまとめます。
以上
