英語の文章を分解する

質問

英語の文章を単語ごとに分解し、アルファベット順に並び替えて、使用頻度などのデータに利用したいと思います。
一回に500～1000 waord を考えています。
文章は、Word またはメモ帳から取ります。
この処理で私にできるのは、エクセルのひとつのセルに貼り付けて、マクロにより、単語ごとに分解し、あとでソートする方法です。

たとえば、「This is a pen.」という文章をA1のセルに貼り付け、マクロを起動して、
A2 This
A3 is
A4 a
A5 pen
というように単語を入れていきます。
できれば、「.」「"」「?」「!」「,」などの記号は同時に削除したいのです。
自分でも、いい加減なマクロは作れますが、仕事に使いますので上手な方のものを使わせていただきたいと思います。
よろしくお願いします。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

Office カテゴリで、たぶん、あなたに回答している者です。まあ、Officeを使用するなら、そちらでも回答はつきます。

簡単な方法としては、最初に、Split で別けて、それを一つずつ、Dictionary オブジェクトで、ダブルものは、数えて、一覧に出せばよいです。ワークシート関数が得意な人は、ワークシートで処理してしまうほうが、スピード的には速いです。

配列にしていますから、Excelの方が、出力しやすいでしょうね。

ただ、そのようなツールは、既に出ているような気がします。

別の場所に書きましたが、もし学生さんでないのでしたら、なおさら、お金を掛けたほうがよいです。英語のカテゴリで、そのようなツールに精通している人がいるような気がします。私は、ここ最近、英語関係のツールから遠ざかっていますので、新しい情報をぜんぜん持っていません。私が購入したものは、ほとんど、販売中止になってしまっていました。

さて、今回のご質問では、簡単なサンプルを作ってしまいました。本当は、Perl 辺りで作る人がいるような気がします。以下は、Excelで整理しますので、Excel VBAです。

なお、通常、そのようなツールでは、1文字ないし2文字は省くという規則があります。ここでは、さすがに、文字列の長さ1文字は、カウントしないことにしました。

'--------------------------------------------------------------

Sub MyDicObject()
　Dim objDic As Object　'Scripting.Dictionary
　Dim objFS As Object　 'Scripting.FileSystemObject
　Dim mySrc As String
　Dim Ar As Variant
　Dim v As Variant
　Dim d As Variant
　Dim k As Long
　Set objDic = CreateObject("Scripting.Dictionary")
　Set objFS = CreateObject("Scripting.FileSystemObject")

　'ファイル名(テキストファイル)
　Const FNAME As String = "C:\testdocument.txt"

　mySrc = objFS.OpenTextFile(FNAME).ReadAll

　'除外文字
　For Each d In Array("""", "!", "?", ".", ",", "(", ")")
　　mySrc = Replace(mySrc, d, "")
　Next
　'改行コードの置換
　　mySrc = Replace(mySrc, vbCrLf, " ")

　Ar = Split(mySrc, " ") '配列変数に代入
　k = 1
　With objDic
　　For Each v In Ar
　　　'一文字と数字は省く
　　　If Len(v) > 1 And Not IsNumeric(v) Then
　　　　If Not .Exists(v) Then
　　　　　.Add v, k
　　　　　.Item(v) = 1
　　　　Else
　　　　　.Item(v) = .Item(v) + 1
　　　　End If
　　　　k = k + 1
　　　End If
　　Next v
　　Range("A1:B1").Value = Array("単語", "回数")
　　Range("A2").Resize(.Count).Value = Application.Transpose(.keys)
　　Range("B2").Resize(.Count).Value = Application.Transpose(.items)
　End With
　'ソート
　 Range("A1").CurrentRegion.Sort _
　　　Key1:=Range("A2"), _
　　　Order1:=xlAscending, _
　　　Header:=xlYes, _
　　　OrderCustom:=1, _
　　　MatchCase:=False, _
　　　Orientation:=xlTopToBottom

　Set objFS = Nothing
　Set objDic = Nothing
End Sub

回答No.1

kotaro0127

もう少し、どこが分からないのか教えてください。
まるなげですと、回答が付かないですよ。

>仕事に使いますので上手な方のものを使わせていただきたいと思います。
?????