自動俳句作成ソフト

ついにイグノーベル賞ものの、自動俳句作成ソフトが完成しました。

① 冗句作成ソフト完成

やっていることは、有名古典俳句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を調べる。3なら季語。
  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
 
VBA別館
最終セルの番地を調べる

知っていてもすんなりcodeは出てきませんので、便利帳代わりに書いておきます。① データの最終行を知 …

VBA別館
メッセージボックスの使い方

VBAでプログラムを書いた後、プログラムを動かすとエラー続出なんてことは日常茶飯事です、僕は。そこで …

VBA別館
有名俳句集 ver1.1

一茶や芭蕉などの有名俳句をまずは200句学んでみましょう。スタートすると俳句が出てきて2秒後にその俳 …