文章の分割

日本語で書かれた文章が手元にあります。

新聞記事の一部です。１００文字くらい。単語３０個くらいから構成。

これを、WORDに内蔵の辞書を使って、単語ごとに分割して
それを、CSVかEXCELへ、単語ごとに縦列にずらっと
並べてアウトプットする、マクロを教えてください

WORD2010です

No.4 回答者： WindFaller 回答日時： 2016/11/27 23:53

>　Set xlApp = 　(, "Excel.Application")

すみません。先程、戻し忘れに気が付きましたが、急いで訂正文を出そうと思ったら、先に書かれてしまっていました。うっかり、参照設定したままでしたので、

その上の　
Dim xlApp As Excel.Application 'Object
　　↓
Dim xlApp As Object
に直してください。
それで、今、私のほうも、いろいろ思い出しながらも考えることがあります。この題材は、もうかれこれ8・9年前からの宿題です。

今考えているコードは、途中で、これは、形態素解析ではないのかなって思ったのです。（でも、明日・明後日とか短い期間では作れないでしょう。)

とかく、VBA/VB系の人たちは、思った以上にこの方面は暗いのです。もしかして、こちらの世界には明るい方でしたら、少しその方面のことを教えていただいたら、分かるような気がします。

#3に書いたこと、#3のお礼欄の補足の話、自分の考えが冷めないうちに、アップするつもりです。
単語分析ですから、そこから、助詞・助動詞（今のところ口語体のみ)を抜くことですが、問題は動詞の語尾変化があります。時々見かけるツールではあるのですが、それは英語ですので、日本語では、やっぱり形態素解析をするのかなって思います。今のところ、名詞レベルにとどまってしまいます。

形態素解析のサンプル
http://gengoro.zoo.co.jp/

だから、本当は、Excelにラッパーを付けて、形態素解析まで行きたいという思いはあります。（それは勝手にやれ! と言われそうですね)
オンラインで書いているので、変なところがありましたら、ご容赦ください。

この回答へのお礼

すみませんが、最終的に　このようにしています。
例の箇所です

Sub TokenSeparates2Excel()
Dim mText As String
Dim fNo As Integer
Dim fn As String
Dim wd As Variant
Dim buf As String
Dim i As Long, j As Long
Dim ar, arBuf, a
Dim xlApp As Object
　①＝＝＝＝＝＝＝＝＝＝
i = 1
For Each wd In ActiveDocument.Words
If Len(Trim(wd.text)) > 0 Then
mText = mText & i & ":" & Trim(wd.text) & vbCrLf
i = i + 1
End If
Next wd
'エクセル用の出力に変更
arBuf = Split(mText, vbCrLf)
ReDim ar(0 To i - 1, 1)
For j = 0 To UBound(arBuf) - 1
a = Split(arBuf(j), ":")
ar(j, 0) = a(0)
If UBound(a) = 1 Then
ar(j, 1) = a(1)
End If
a = ""
Next j
'出力
On Error Resume Next
　Set xlApp = 　(, "Excel.Application")
　②＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
　③＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
以下省略
①は修正しました
②はコンパイルエラーがでます　構文エラー
③は大丈夫でしょうか

形態素解析は、難しいですし、直ちに問題としない扱いとして
考えています。

このマクロでなくて、最初にいただいたVBAで２万行で実行すると
画面がフリーズしました。(￣∇￣;)ハッハッハ

お礼日時：2016/11/28 22:11

No.3 回答者： WindFaller 回答日時： 2016/11/27 17:18

お礼欄の中から、

>CSVやEXCELがどこにあるのやら。
>デスクトップを見渡しましたが保存されていませんでした
そのテキストファイルは、Wordのデフォルトフォルダーにあります。

では、それをExcel渡すにはどうするか、というご質問でよろしいでしょうか？

後は手動で、名前を付けて保存してください。
もちろん、既存のブックにも出力することが可能です。

ところで、この出来上がったものって、確か、kwicとか コンコーダンスとか言う処理の前段階のような気がします。もしかしたら、この後に、助詞・助動詞、記号、句読点を除いて、単語の頻出度を出すということではありませんか？ふと、そんな想像してしまいました。

もし、そうだとしたら、ある程度の作業は、メモリ上で処理をしたほうがよいかもしれませんね。

'//
Sub TokenSeparates2Excel()
　Dim mText As String
　Dim fNo As Integer
　Dim fn As String
　Dim wd As Variant
　Dim buf As String
　Dim i As Long, j As Long
　Dim ar, arBuf, a
　Dim xlApp As Excel.Application 'Object
　i = 1
　For Each wd In ActiveDocument.Words
　　If Len(Trim(wd.text)) > 0 Then
　　　mText = mText & i & ":" & Trim(wd.text) & vbCrLf
　　　i = i + 1
　　End If
　Next wd
　'エクセル用の出力に変更
　 arBuf = Split(mText, vbCrLf)
　 ReDim ar(0 To i - 1, 1)
　 For j = 0 To UBound(arBuf) - 1
　　 a = Split(arBuf(j), ":")
　　 ar(j, 0) = a(0)
　　 If UBound(a) = 1 Then
　　　 ar(j, 1) = a(1)
　　 End If
　　 a = ""
　 Next j
　'出力
　On Error Resume Next
　Set xlApp = 　(, "Excel.Application")
　If xlApp Is Nothing Then
　　Set xlApp = CreateObject("Excel.Application")
　End If
　If xlApp Is Nothing Then
　　MsgBox "Excelが立ち上がりません。", vbExclamation
　　Exit Sub
　End If
　Dim NewBook As Object
　With xlApp
　　.Visible = True
　　Set NewBook = .Workbooks.Add
　　NewBook.Worksheets(1).Range("A1").Resize(i - 1, 2).Value = ar
　End With
　Beep
End Sub
'//

p.s.エクセル側は、決まったブックに新たなマクロを搭載して、処理を完成させるとかできます。もちろん、Wordからも可能です。でも、そんなことを言ったら、誰かは、そんなことなら、はじめからエクセルでやれとか言われそうですが、そうなると、遥かに難しくなりそうですね。

この回答へのお礼

WORDのディフォルトのフォルダーからTEXTファイルを見つけることができました。感謝です。


究極的には、それをしたいのです。
文章を単語に分割して、各々の単語の頻出度合いをみたいのです
ちなみに、もともとの文章群は、エクセルにあり、
平均７０文字位が各セルに入力されており、
縦方向に３万行あります。文字数で２１０万文字。
これらの中で使われている単語の頻出度合いを測りたいのです。

VBAの構文を新しくいただきましたが、私が素人でよくわかりません
とりあえず、新しいWORDへ貼り付けましたが

①Dim xlApp As Excel.Application 'Object　が定義されていないと表示されました
② '出力
On Error Resume Next
　Set xlApp = 　(, "Excel.Application")のあたりが、赤色の文字になっています、意味は不明です

結局、マクロが走っていないように思えます。
たくさん、時間をいただいてありがとうございます

いま23時ですので、追加で私の方が気づくことがあれば、また明日に補足します。ずいぶんとたすけていただきました。

お礼日時：2016/11/27 23:02

No.2 回答者： WindFaller 回答日時： 2016/11/27 12:00

こんにちは。

Wordに内蔵された機能を使うのでしたら、以下のようになります。

'//
Sub TokenSeparates()
　Dim mText As String
　Dim fNo As Integer
　Dim fn As String
　Dim wd As Variant
　Dim buf As String
　Dim i As Long
　i = 1
　For Each wd In ActiveDocument.Words
　　If Len(Trim(wd.text)) > 0 Then
　　　mText = mText & i & ":" & Trim(wd.text) & vbNewLine
　　　i = i + 1
　　End If
　Next wd
　MsgBox mText
　'出力
　fn = "Token_wds.Txt"
　fNo = FreeFile()
　Open fn For Output As #fNo
　Print #fNo, mText
　Close #fNo
　Beep
End Sub

'//

この回答へのお礼

すごいです。ありがとうございます
出たのですが、表示が、別のWINDOWのようなものです。
縦に、連番号が続き、各番号の右側に、期待している単語が並んで
縦に長い帯のようなWINDOWに表示されて　でてきました。
CSVやEXCELがどこにあるのやら。
デスクトップを見渡しましたが保存されていませんでした

お礼日時：2016/11/27 16:21

No.1 回答者： don_go 回答日時： 2016/11/27 03:03

＞単語ごとに分割して

例文
「机の上にバッグを置いておく」

・辞書を使って、単語毎に分割
「机/の/上/に/バッグ/を/置いて/おく」

・文節単位で分割
「机の/上に/バッグを/置いて/おく」

・「新聞記事」を分割
「新聞記事」又は「新聞/記事」

freeforvirusさんが求めているのは、どんな結果ですか？

この回答へのお礼

そうですね、日本語は言葉が変化するので形態素分析が必要でしょうが、ここでは単語ごとです
・机/の/上/に/バッグ/を/置いて/おく
・新聞/記事

です。基礎知識がなく、困っています。
WORDファイルを開けて
机の上にバッグを置いておく
とタイプアップし、ファイル名を「テストテスト」として、ファイル保存形式をマクロ付きのWORDでデスクトップとする場合の方法を知りたいです

ALT+11
ALT+8
くらいまでわかっています。
ALT+11で、NORMALの標準モジュールにはりつけるのですね

お礼日時：2016/11/27 16:14