同じ種類の単語だけを抽出したい

質問

はじめまして。
いま、Wordに以下のようなデータがあります。
　　What_2 is_1 a_1 burrito_0? What_2 is_1 that_3?
（各英単語の後ろに、アンダーバーと数字がついています）
これを、同じ数字が付いている単語を抽出してエクセル等でリストを
作りたいのですが、何か良い方法はないでしょうか？
たとえば、以下のようなリストが理想です。
（英単語の後ろにある数値は頻度です）
----------
0
burrito 1

1
a 1
is 2

2
what 2
----------
どうぞ、よろしくお願い致します。

回答No.3

cistronezk · ベストアンサー

マクロを使わないなら、次のような手順でしょうか。

（１）
What_2 is_1 a_1 burrito_0? What_2 is_1 that_3?
という文を
What_2
is_1
a_1
burrito_0?
What_2
is_1
that_3?
のように１単語ずつ改行させる。

この方法としては、Wordにおいて「検索と置換」ダイアログを表示します。「検索する文字列」に「＜スペース＞」を指定、「置換後の文字列」に「^p」（改行記号）を指定して「すべて置換」します。
さらに「？」も邪魔なので次のようにして消去します。「検索する文字列」で「?」を指定、「置換後の文字列」に空欄（つまり何も指定しない）として「すべて置換」します。もし、ピリオドやカンマがあれば、それも同様に削除してください。

（２）
こうして１単語毎に改行した文書を「名を付けて保存」で「ファイルの種類」を「書式なし（*.txt）」形式で保存します。

（３）（２）のテキストファイルをExcelで開きます。
ファイルを開くと「テキストファイルウィザード」が表示されます。
「１／３」はそのまま「次へ」、「２／３」の区切り文字で「その他」をチェックし「_」を入力します。完了ボタンを押します。

以上で、A列に単語、B列に数値が入力されます。

（４）
頻度を算出します。
まず、データ全体を選択してA列でソートします。昇順・降順は問いません。
次にセルC1に以下の式を入力します。
=IF(A1<>A2,COUNTIF(A1:A,A1),"")
セルC1をコピーして、単語のある行全部のC列にコピーします。
C列を選択してコピーし、そのまま「形式を指定して貼り付け」で「値」を指定して貼り付けます。
データ全体を選択してC列でソートします。C列が空欄の行を削除します。

以上で、必要な情報が取得できたはずです。後は好きなようにフォーマットを修正してください。

お礼

cistronezkさん、ご回答ありがとうございました。
マクロは手が出なかったのですが、教えていただいた方法でしたらすぐに出来ます。急いでいたので本当に助かりました。

回答No.5

mitarashi

#1です。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_01.html
こちら等で、お勉強なさってください。
参考URLの様にやった後、自動記録されたマクロを全部消して、#1のコードを貼り付けていただいても可です。（先頭のDim rowCounter As Longもお忘れなく）
若干の補足をしておきます。
VBAの行の先頭に'（シングルクォーテーション）が付いていると、その行はコメント扱いとなり、実行されません。初期状態では、ご質問の一行の例だけを対象に処理する様になっております。実際にテキストファイル全体を処理する場合は、'B:云々の下の1行をコメントとし、'A:云々の下のコメントにしてある7行の’を外して生かす必要があります。

また、処理対象のファイルの名前の部分と、
For j = 0 To 9 Step 1
の9の部分を、実際に合わせて変更する必要があります。9のところは、10以上でも動作する筈です。

お礼

mitarashiさん、詳しい説明をしていただき、本当にありがとうございました。この処理は、できるだけ早くしなければならないので、今回はWordとExcelの基本的な機能だけでやってしまおうと思います。
ただ、マクロは勉強しておいたほうがよいと思うので、この作業が終わったら紹介してくださったサイトなどを見てみます。
本当にありがとうございました。

回答No.4

cistronezk

回答３の（４）の式が間違ってました。

誤）
＞=IF(A1<>A2,COUNTIF(A1:A,A1),"")
正）
=IF(A1<>A2,COUNTIF(A:A,A1),"")

です。失礼しました。

回答No.2

Wendy02

こんばんは。

#1さんの回答と同じような回答しても仕方がありませんから、別の方法を述べさせていただきます。

ご質問は、私の仕事範囲にも近いのですが、実際、自分の仕事関連なら、マクロは組みません。テキストエディタで、一行にひとつにするように単語に切り分けます。

テキストエディタで、このようにします。
-------------------------------------------
What 2
is 1
a 1
burrito 0?
What 2
is 1
that 3
-------------------------------------------

それをExcelに貼り付けて、それを並べ替えと、フィルタ・オプションで重複を取るという方法を取ります。

ところで、

　What_2 is_1 a_1 burrito_0? What_2 is_1 that_3?

その数字は、どのように作られたものでしょうか。その数字は、もともと、何かソーステキストから、頻度ほ出して、それをWordマクロで貼り付けたもののようです。この数字は、What と　is の数字が違うので、どうやら、標準頻度（例：ALCのSVL)ではなさそうです。0は、頻度のランキング外にあるものだと思います。

この文章に、_1 など付いていなければ、ふつう大学等で出しているコンコーダンサー(Concordancer)というツールがあるので、そこからリストを作ればよいと思います。要するにご質問の目的は、コンコーダンサーなどで作られたリスト表がほしいということだと思います。ただし、コンコーダンサー自体は、単なる頻度だけです。

お礼

ご回答、ありがとうございました。
マクロの方も興味深かったのですが、明朝までにやらなければならないので、Wendy02さんに教えていただいた方法でやりたいと思います。
ちなみにこの数字は、JACET8000という語彙リストのレベル分け（Level1～Level8）の数字で、0はLevel8外という意味です。

回答No.1

mitarashi

Excel VBAのコードです。先日文章中の特定文字列のカウントの回答をしたものを改造してみました。ご呈示の文例では動作しましたが、他の文例に対しても適用できるかどうかは不明ですので、あらかじめ言い訳をしておきます。
'A部のコメントアウトを外すと、テキストファイルを読み込んで処理します。（Wordのファイルではありませんので悪しからず。Wordからテキスト形式で保存してから処理してください。実際のテキストファイルのパス、ファイル名に合わせてコードを変更して下さい。）
その場合、B部のテストデータ部はコメントアウトして下さい。
末尾のmyCellPrintは、debug.printで試験したのを書き換えるのが面倒なので、ワークシート上でシミュレートしようと即興で作成してみました。分かり難くしているだけと思いますがご容赦下さい。
Dim rowCounter As Long

Sub Test()
Dim FSO, buf As String
Dim strPattern As String
Dim srcFilePath As String
Dim Matches As Variant
Dim i As Long, j As Long
Dim myDic As Object
Dim myKey As Variant
Dim hitWord As String

'A:read from Textfile
' srcFilePath = "C:\Documents and Settings\?????\デスクトップ\testText.txt"
' Set FSO = CreateObject("Scripting.FileSystemObject")
' With FSO.GetFile(srcFilePath).OpenAsTextStream
' buf = .ReadAll
' .Close
' End With
' Set FSO = Nothing

'B:Test Data
buf = "What_2 is_1 a_1 burrito_0? What_2 is_1 that_3?"

rowCounter = 0
Cells.Clear
For j = 0 To 9 Step 1
strPattern = "(\S+)_" & CStr(j) & "[ .?]"
With CreateObject("VBScript.RegExp")
.Pattern = strPattern
.Global = True
Set Matches = .Execute(buf)
End With
myCellPrint j
If Matches.Count > 0 Then
Set myDic = CreateObject("Scripting.Dictionary")
For i = 0 To Matches.Count - 1
hitWord = Matches(i).submatches(0)
If Not myDic.exists(hitWord) Then
myDic.Add hitWord, 1
Else
myDic.Item(hitWord) = myDic.Item(hitWord) + 1
End If
Next i
myKey = myDic.keys
For i = 0 To myDic.Count - 1
myCellPrint myKey(i), myDic.Item(myKey(i))
Next i
Set myDic = Nothing
End If
myCellPrint
Next j
End Sub

'debug.print をワークシートでシミュレートしたつもり
Sub myCellPrint(Optional arg1 As Variant, Optional arg2 As Variant)
If rowCounter = 0 Then rowCounter = 1
If Not IsMissing(arg1) Then
Cells(rowCounter, 1).Value = arg1
If Not IsMissing(arg2) Then Cells(rowCounter, 2).Value = arg2
End If
rowCounter = rowCounter + 1
End Sub
正規表現でパターンマッチングしています。
strPattern = "(\S+)_" & CStr(j) & "[ .?]"
のところは環境に合わせて修正して下さい。
「VBA 正規表現」で検索すると多数参考サイトが見つかります。

補足

mitarashiさま、ご返答いただき、ありがとうございます。
せっかくVBAコードを書いていただいて恐縮ですが、、VBAの知識がなくExcelに組み込むことすらできないので、残念ながら実行出来ません。
もしもお時間があるようでしたら、エクセルのど素人にも分かるように使い方を教えていただけないでしょうかm_ _m