この前自分のプリントで並べ替えを作っていて、案外ランダムに並べ替えるの面倒だな、と思いました。元の文→単語ごとに頭の中で分解→ランダムっぽく配置し、"/"とかで区切る。
じゃあこれをパパっとやってくれるプログラムを作ればいいんじゃないか、そうだ僕にはVBAがある、と。
（ちなみにその時僕には時間がなかったのですがなぜかこういうのは突然優先順位上の方に入ってくるんだよな…!!）
ということで、1時間くらいかけて作りました。ドーン！
（もしこれ動かしてなんか変なことになっても責任は当然取れませんのであしからず…）
Dim nowRow As Integer 'プロシージャをまたいで使うのでまず宣言
Sub 総合()
MaxRow = ThisWorkbook.Worksheets(1).Range("B1").End(xlDown).Row '「原文」列が何行あるか数える
For nowRow = 2 To MaxRow 'その行数分、並び替えを続ける
Call この1列
Next
Range("A1").Select 'なんとなくカーソルをA1に戻す
End Sub
Sub この1列()
Target = Cells(nowRow, 2).Value '原文取得
LastT = Right(Target, 1) '最後の1文字（"."か"?"）をとっておく
Target = Left(Target, Len(Target) - 1) 'ひとまず最後の1文字を消す
ChaN = Len(Target) - Len(Replace(Target, " ", "")) + 1 'スペースの数＋1が単語数（ChaN）
splTarget = Split(Target, " ") '空白で区切って配列に格納
For n = 2 To ChaN + 1 '2行目から[単語数＋1]行目までFor
Cells(n, 7) = splTarget(n - 2) 'G列に1語ずつ入れる
Cells(n, 8) = Rnd 'H列に並べ替え用の乱数を入れる
Next
Range(Cells(2, 7), Cells(ChaN + 1, 8)) _
.Sort Key1:=Range("H2"), order1:=xlAscending 'G:HをH列で並べ替え
narabekae = "( " 'D列に入れる文字列を作成開始（narabekae）
For n = 2 To ChaN + 1
narabekae = narabekae & Cells(n, 7).Value & " / " 'G列上から入れ、" / "で区切る
Next
narabekae = narabekae & ")" & LastT '最後は括弧で閉じて"."か"?"を末尾に足す
narabekae = Replace(narabekae, " / )", " )") '最後の一語の処理
narabekae = Replace(narabekae, "+", " ") '一緒になっていた語をバラバラに
Cells(nowRow, 4).Value = narabekae '完成したものをD列に入れる
Range("G2:H100").Clear '計算用の列は削除
'C列に正解の文章を入れる
Seikai = Cells(nowRow, 2).Value 'もう一度原文を取得
Seikai = Replace(Seikai, "+", " ") '"+"を" "に置換
First = StrConv(Left(Seikai, 1), vbUpperCase) '最初の一文字を切り出し、大文字に
Seikai = First & Mid(Seikai, 2, 100) '大文字にした1文字目と、そのままの2文字目以下を合体
Cells(nowRow, 3).Value = Seikai '完成したものをC列に入れる
End Sub（VBAの使い方不安な方はこの辺りを見るといいかと！→ Office TANAKA - 今さら聞けないVBA「マクロってどこに書けばいいの？」）
「原文」列に、元の文章を入れます。
この際、文頭も小文字にすること（Iとか固有名詞の場合は大文字でOK）と、並べ替えの際にくっつけておきたい連語等は半角スペースを空けず"+"（半角）でつなぐことに注意。
| A | B | C | D |
|---|---|---|---|
| No. | 原文 | 解答 | 並べ替え |
| 1 | how dare you say such a thing? | ||
| 2 | Kagawa has+decided to transfer to one of the+most+popular football+teams. | ||
| 3 | this+book made me think that UFOs exist. | ||
| 4 | our+classroom is used by the+brass+band now. | ||
| 5 | Jennifer must not have said such+a+thing to you. |
こういうファイルに対して、「総合」のマクロを実行すると、
| A | B | C | D |
|---|---|---|---|
| No. | 原文 | 解答 | 並べ替え |
| 1 | how dare you say such a thing? | How dare you say such a thing? | ( such a thing / say / you / how / dare )? |
| 2 | Kagawa has+decided to transfer to one of the+most+popular football+teams. | Kagawa has decided to transfer to one of the most popular football teams. | ( of / the most popular / one / transfer / to / to / Kagawa / has decided / football teams ). |
| 3 | this+book made me think that UFOs exist. | This book made me think that UFOs exist. | ( this book / that / exist / me / made / UFOs / think ). |
| 4 | our+classroom is used by the+brass+band now. | Our classroom is used by the brass band now. | ( used / now / is / our classroom / the brass band / by ). |
| 5 | Jennifer must not have said such+a+thing to you. | Jennifer must not have said such a thing to you. | ( you / must / Jennifer / have / such a thing / said / not / to ). |
こうなるでがす。
あとはそれぞれの行をしかるべきところにコピペすれば問題と解答が揃います。
ちなみに本当は「フォーム」を置いてそこにマクロを貼り付けて、フォームをぽちっと押せばマクロ実行、とやりたかったんだけど、どうやらmacではそういうのできないくさい??
Excel for Mac 2011でマクロが登録してあるオブジェクトを起動するとファイルを二重に開かれちゃう件
ご存知の方いましたらぜひお教えくださいm(_ _)m
これちょっと応用すれば、不要な一語が混ざってるパターンとか、必要な一語が足りないパターンとかできそうだな…!!
今日は体調が悪いからあんまり生産的なことをしたくない感じなので、こんなことやって早く寝ようと思います。それではっ！
