文章を末尾から並べ替え

質問

何らかのソフトや関数を使い、多種多様な文章を、語尾から50音順に並べ替えることはできるでしょうか？

たとえば、
1.花は赤い（はなはあかい）
2.空は青い（そらはあおい）
3.雲は白い（くもはしろい）
4.雪は白い（ゆきはしろい）
という文章があったとして、語尾から50音順で

1.空は青い（そらはあおい）
2.花は赤い（はなはあかい）
3.雪は白い（ゆきはしろい）
4.雲は白い（くもはしろい）

と並べ替える手段を探しています。

使用目的は、書籍や報告書等の文章の塊から、
どんな言葉や動詞が使われているか、等を分析したいためです。

どうぞよろしくお願いいたします。

回答No.5

noname#140971 · ベストアンサー

[Sheet1（コード）]に関して

１、[Sheet1]のタグを右クリック[コードの表示]を更にクリック。
２、以下のコードをコピペ。

Private Sub CommandButton1_Click()
　　Dim I　　　　As Integer
　　Dim N　　　　As Integer
　　Dim Datas()　As String

　　Datas() = FileReadArray("C:\temp\test.txt")
　　DatasReverse Datas()
　　QuickSort Datas()
　　DatasReverse Datas()
　　N = UBound(Datas())
　　For I = 0 To N
　　　　FileAppend "C:\Temp\testII.txt", Datas(I)
　　Next I
　　FileAppend "C:\Temp\testII.txt", ""　　 ' 閉じるためのコード
End Sub

Public Sub DatasReverse(ByRef Datas() As String)
　　Dim I　　　 As Integer
　　Dim N　　　 As Integer

　　N = UBound(Datas())
　　For I = 0 To N
　　　　Datas(I) = StrReverse(Datas(I))
　　Next I
End Sub

今回は、[Test.txt]を並びかえて[TestII.TXT]に書き出しています。
今回は、逆順入れ替えをサブルーチンにしています。

[標準モジュール]に関して

１、[Sheet1]のタグを右クリック[コードの表示]を更にクリック。
２、メニューの[挿入]-[標準モジュール]をクリック。
３、以下の関数をコピペ。

留意事項は、

FileAppend "", ""

でも構いませんのでファイルシステムオブジェクトを破棄するコードを忘れないことです。
なお、クイックソートにルーチンは高速のそれではありません。
もっとも、初歩的で判りやすいルーチンとされるものです。

Public Function FileReadArray(ByVal FileName As String) As String()
On Error GoTo Err_FileReadArray
　　 Dim fso　　　　As Object
　　 Dim strTexts() As String

　　 Set fso = CreateObject("Scripting.FIleSystemObject")
　　 strTexts() = Split(fso.OpenTextFile(FileName).ReadAll, vbCrLf)
Exit_FileReadArray:
　　 FileReadArray = strTexts()
　　 Exit Function
Err_FileReadArray:
　　 MsgBox Err.Description & "(FileReadArray)", vbExclamation, " 関数エラーメッセージ"
　　 strTexts() = Split("")
　　 Resume Exit_FileReadArray
End Function

Public Function FileAppend(ByVal FileName As String, ByVal TEXT As String) As Boolean
On Error GoTo Err_FileAppend
　　Static isOpen As Boolean
　　Static fso　　As Object
　　Static txs　　As Object

　　If Not isOpen Then
　　　　isOpen = True
　　　　Set fso = CreateObject("Scripting.FIleSystemObject")
　　　　Set txs = fso.CreateTextFile(FileName, True)
　　End If
　　If Len(TEXT) > 0 Then
　　　　txs.WriteLine TEXT
　　End If
　　FileAppend = True
Exit_FileAppend:
On Error Resume Next
　　If Len(TEXT) = 0 Then
　　　　isOpen = False
　　　　Set txs = Nothing
　　　　Set fso = Nothing
　　End If
　　Exit Function
Err_FileAppend:
　　Resume Exit_FileAppend
End Function

Public Sub QuickSort(ByRef Datas() As String)
　　QSort Datas(), 0, UBound(Datas())
End Sub

Public Sub QSort(ByRef Datas() As String, _
　　　　　　　　 ByVal intTop As Integer, _
　　　　　　　　 ByVal intLast As Integer)
　　Dim I As Integer　　　　　　　　　　　　' ループの索引
　　Dim J As Integer　　　　　　　　　　　　' ループの索引
　　Dim R As Integer　　　　　　　　　　　　' 分割した右側の配列の要素数
　　Dim N As Integer　　　　　　　　　　　　' 比較する配列の総数
　　Dim Temp As String　　　　　　　　　　　' 配列を一時的に保存する
　　Dim Part As String　　　　　　　　　　　' 配列を分割するテストに選ばれた要素

　　N = intLast - intTop + 1
　　If N < 2 Then
　　　　Exit Sub
　　End If
　　'　 intTop = 0, N = 5 ---> 0 + 5 / 2 = 2
　　'　 intTop = 1, N = 3 ---> 1 + 3 / 2 = 2
　　'　 テスト値には、対象となる配列の真ん中を選ぶ
　　Part = Datas(intTop + Int(N / 2))
　　I = intTop - 1
　　J = intLast + 1
　　Do
　　　　' 左から比較する
　　　　Do
　　　　　　I = I + 1
　　　　Loop While (StrComp(Datas(I), Part) = -1)
　　　　' 右から比較する
　　　　Do
　　　　　　J = J - 1
　　　　Loop While (StrComp(Datas(J), Part) = 1)
　　　　' 左右の比較作業が出会わなかったら、
　　　　' I と J の要素を入れ替える
　　　　If (I < J) Then
　　　　　　Temp = Datas(I): Datas(I) = Datas(J): Datas(J) = Temp
　　　　End If
　　Loop Until (I >= J)
　　R = N - I
　　QSort Datas(), 0, I - 1　　　　　' 左側部分の配列をソート
　　QSort Datas(), I, I + R - 1　　　' 右側部分の配列をソート
End Sub

ところで、全てのコードは、VB6.0 でもそのまま動作します。
ですから、VB6.0で書くのがお勧め。
その際にファイル名を指定するように改造すれば、小さなフリーソフトまがいが出来上がります。
どなたか知人にでも頼まれるとチャッチャと作ってくれませんかね。

お礼

できました！！どうもありがとうございました。
ご親切にご説明、というかコピペだけで出来るように
していただいて、感謝です！！！！
この並べ替えのおかげで、1ヶ月以上はかかるかな、
なんて考えていた仕事が短時間でできそうです！
プログラムが書けるっていいですね。
ちょっと勉強してみようかなあ、という気持ちになりました。
本当にどうもありがとうございました。

回答No.4

imogasi

小生門外漢なれど、VBAで「空は青い」を「イオアハラソ」に直しても質問の主旨に役立たないと思います。質問標題がそれを希望するように取れますが。
やはり文章から、単語の切り出しが、まず必要であって、
空、は、青いのように分解できないと、「青い」という「ア」のソートの最初桁も割り出せないのではないでしょうか。
単語の割り出しは、過去にどなたかが作成している単語や語句辞書を参照しないと、プログラムにルールだけ乗せて、達成できるものではないと思うし、かな漢字変換の機能のようなことをせねばならず、ジャストシステムやMSなどが今まで苦労してきたことを後追う形で個人でやるのは無理でしょう。ですから＃２でおっしゃっているように、専門ソフトを使わざるを得ないと思います。
ワードVBAで、ワードの文書に対しては、ややそれに近いことをやってくれますが。
ーー
単語検索
検索方法：キーワード検索（前方一致・後方一致・完全一致・部分一致）、関連 語検索（前方一致・後方一致・完全一致・部分一致）、全文検索、目次検索・・
http://www.densijiten.co.jp/news/press.php?disp=detail&nid=118
形態だけでなく
日本語シソーラス
http://www.taishukan.co.jp/item/nihongo_thesaurus/thesaurus.htmlのような仕組みができるのが目的かと思いましたが。

お礼

そうですね、おっしゃっているようなことができれば理想です。
ただそれは個人では難しいのですね・・・。
言葉に関することは、なかなかコンピューターで割り切れるものでは、
ないようですね。
教えていただいた「広辞苑第五版＋日本語大シソーラス」チェックしてみます。
本当に有難うございました。

回答No.3

noname#140971

＜Test.txt＞

1.花は赤い（はなはあかい）
2.空は青い（そらはあおい）
3.雲は白い（くもはしろい）
4.雪は白い（ゆきはしろい）

を

2.空は青い（そらはあおい）
1.花は赤い（はなはあかい）
4.雪は白い（ゆきはしろい）
3.雲は白い（くもはしろい）

と、並べてエクセルに表示するのは割りと簡単です。

Private Sub CommandButton1_Click()
　　Dim I　　　 As Integer
　　Dim N　　　 As Integer
　　Dim Datas() As String

　　Datas() = FileReadArray("C:\temp\test.txt")
　　N = UBound(Datas())
　　For I = 0 To N
　　　　Datas(I) = StrReverse(Datas(I))
　　Next I
　　QuickSort Datas()
　　For I = 0 To N
　　　　Datas(I) = StrReverse(Datas(I))
　　　　Me.Cells(I + 1, 1) = Datas(I)
　　Next I
End Sub

ここでは FileReadArray関数、QuickSort関数を利用しています。
この２つの関数は、エクセルの標準モジュールに登録する必要があります。

コード自体は、簡単です。
先ず、FileReadArray関数でDatas()という配列変数に呼び込んでいます。
次に For-Next文で文字列を逆にしています。
その後、QuickSort関数で並び替えて、また、For-Next文で文字列を逆にして元に戻しています。
ですから、数字も含めて並び代わっています。

さて、こういうVBA解決が質問者のニーズに答えているか否かは不明です。
ですから、FileReadArray関数、QuickSort関数の紹介は一応保留しておきます。
必要があれば補足します。

補足

早速ご回答ありがとうございました！
実は関数についての知識があまりなく、
「FileReadArray関数、QuickSort関数」とはどんなものか？
「それらををエクセルの標準モジュールに登録」とはどうするのか？
の2点がわかりません・・・。
もしよろしければ、教えていただけると大変助かります。
参考となるHP等でも結構です。
よろしくお願いいたします。

回答No.2

hukuponlog

直接の回答にはなりませんが、もし使用目的が
>書籍や報告書等の文章の塊から、どんな言葉や動詞が使われているか、等を分析したい

ということであれば、形態素解析ソフトというものがあります。このソフトは、入力されたテキストデータを単語で区切り、品詞ごとに分類をしてくれるもので、必要に応じて動詞と形容詞だけ、とか、名詞だけとか指定して抽出することも出来ます。
よく自由記述のアンケートの分析に使われています。フリーソフトで大変有名なものとして
http://chasen-legacy.sourceforge.jp/
茶筌というものがあります。

お礼

おお！こんなソフトがあるのですね。
使ってみます。
ただ単語だけひっぱってくると、名詞として使われているのか
動詞の一部として使われているのかわからないですが、
これだと品詞の情報は落ちないわけですね！便利そうです。
ありがとうございました！！

回答No.1

mshr1962

EXCELのVBAにStrReverseという文字を反転させる関数があります。
これを使ったユーザー定義関数で可能だと思います。
VBEの標準モジュールに
Function KanaReverse(MOJI)
KanaReverse = StrReverse(Application.GetPhonetic(MOJI))
End Function
で
エクセルにて
A1="空は青い"
B1=KanaReverse(A1) →　"イオアハラソ"
になります。

ユーザー定義関数の詳細は下記を参照
http://takashixxx.blog88.fc2.com/blog-entry-21.html

お礼

そうなんです！反転できればいいのになあと考えていたのです。
VBAというのを知っていると、いろいろできるんですねえ。
ご紹介いただいたHPで勉強しようと思います。
ありがとうございました。