ついにイグノーベル賞ものの、自動俳句作成ソフトが完成しました。
① 冗句作成ソフト完成
やっていることは、有名古典俳句200句の上五・中七・下五をバラバラにして、乱数でそれぞれをgetして、一つの俳句にしているのです。
意味不明の冗句ができるころが面白い。 誰の句だったかとな、少し考えさせるところが教育的ではあります。
俳句を嗜んでいる方なら、誰と誰の句だと分かるかもしれません。 まずは図をご覧ください。
② VBA code
・全部をvbaで書くと大変なので、エクセルに殆どの処理を任せその結果のみをUserformで表示してます。
お遊びアプリなので簡単にいきましょう（って、それしかできない。）
・このサイトでは、codeのindentは無視されるのでそのままにしてあります（Pythonではerrorとなりますが）。
----------------------------
Private Sub CommandButton1_Click()
Range("H3:J19").Value = "" '前のデータを消しておく
Range("L3:L102").Value = ""
Range("H3:J7").Font.ColorIndex = 1
For m = 0 To 4 reDo: '季語なしや季語重なりの場合はやり直し用の乱数を発生する
n = 200 rnd1 = WorksheetFunction.RandBetween(1, n) + 2 '乱数と行番号を合わせる
rnd2 = WorksheetFunction.RandBetween(1, n) + 2
rnd3 = WorksheetFunction.RandBetween(1, n) + 2 '乱数の確認のためセルに書き出す
Cells(9 + m, 8).Value = rnd1
Cells(9 + m, 9).Value = rnd2
Cells(9 + m, 10).Value = rnd3 '季語の赤字のindexを調べる。３なら季語。
Cells(15 + m, 8).Value = Cells(rnd1, 2).Font.ColorIndex
Cells(15 + m, 9).Value = Cells(rnd2, 3).Font.ColorIndex
Cells(15 + m, 10).Value = Cells(rnd3, 4).Font.ColorIndex
Cells(3 + m, 8).Value = Cells(rnd1, 2).Value '上五,
Cells(3, 8)はRange("H3")と同じです。
Cells(3 + m, 9).Value = Cells(rnd2, 3).Value '中七, Cells(3, 7)はRange("I3")と同じです。
Cells(3 + m, 10).Value = Cells(rnd3, 4).Value '下五, Cells(3, 8)はRange("J3")と同じです。 '季語が一つ有れば良し、ないか二つ以上あればやり直しする
If Cells(15 + m, 8) + Cells(15 + m, 9) + Cells(15 + m, 10) = 5 Then
'MsgBox "季語は合格" Else 'MsgBox "季語不合格、もう一度"
GoTo reDo '最初に戻る
End If
'ここからuserformへの転記を行う。
TextBox1.Text = Cells(3, 8).Value & Cells(3, 9).Value & Cells(3, 10).Value
TextBox2.Text = Cells(4, 8).Value & Cells(4, 9).Value & Cells(4, 10).Value
TextBox3.Text = Cells(5, 8).Value & Cells(5, 9).Value & Cells(5, 10).Value
TextBox4.Text = Cells(6, 8).Value & Cells(6, 9).Value & Cells(6, 10).Value
TextBox5.Text = Cells(7, 8).Value & Cells(7, 9).Value & Cells(7, 10).Value
Next
---------------------------
'第一句の上5、中七、下5の俳人の名前を表示する
Dim k As Integer '上5の最終行
k = Cells(9, 8).Value
Cells(22, 8).Value = Cells(k, 14).Value
k = Cells(9, 9).Value
Cells(22, 9).Value = Cells(k, 14).Value
k = Cells(9, 10).Value
Cells(22, 10).Value = Cells(k, 14).Value '第一句の作者表示
TextBox9.Text = Range("H22").Value
TextBox10.Text = Range("I22").Value
TextBox11.Text = Range("J22").Value
End Sub
-------------------------------------
Private Sub CommandButton2_Click()
Unload Me
End Sub
--------------------------------------
Private Sub UserForm_Initialize()
Label7.Caption = Date
End Sub
