大喜利マクロを作ろう③

久しぶりに歯科検診を受けた。
歯科衛生士さんがそれはそれは丁寧なクリーニングと口内環境の説明をしてくれたが、要約すると「歯が多い」ということだった。
ダイアンの職務質問の漫才以来の衝撃。

ということで、大喜利マクロの続きを作ります。
とりあえず前回までで問題と回答を日付ごとに集計する仕組みはできた。今回は大喜利1問、5問、10問を選択して挑戦できるようにしていきます。

①トップページを作る
まずは超適当なトップページを作って、「1問」、「5問」、「10問」のボタンを作ってみました。

クソダサいけど別に私が個人的に楽しんでいるだけだから関係ない!

②各ボタンに割り付けるプログラムを書く
使いまわししやすいように前回までのプログラムを少し改良します。
共通して使う変数をSubプロシージャの外から出して、モジュールレベルの変数とします。

あとは「お題表示」をボタンに割当てます。

続いて「5問」、「10問」と繰り返すプログラムを作ります。
基本はお題表示のプログラムをコピペして、5問、10問にはタイトル「お題」の横に何問目か表示するようにしたい。
ということで繰り返しためのFor文を書きましょう。

基本的なFor構文
For カウンタ = 開始 To 終了
  処理内容
Next カウンタ

Sub お題5問()
    '「大喜利お題DB」シート、「集計」シートを変数に代入
    Set od = Worksheets("大喜利お題DB")
    Set sk = Worksheets("集計")
    '問題表示を5回繰り返すFor文を作る
    For i = 1 To 5
    Randomize
     'Long型変数mに大喜利お題DBシートのA列でデータが入力されている最終行の番号を代入
    Dim m As Long: m = od.Cells(od.Rows.Count, 1).End(xlUp).Row
    'Long型変数nにデータがあるセルの範囲内で行番号をランダム生成した数字を代入
    Dim n As Long: n = Int((m - 1 + 1) * Rnd + 1)
    'ランダムで選ばれたお題を変数に代入する
    qst = od.Cells(n, 1)
    'タイトル"お題"の横に何問目か表示する
    asw = InputBox(qst, "お題" & i)
    '回答日、お題、回答を「集計」シートに当てはまるように代入していく。
    sk.Cells(WorksheetFunction.CountA(sk.Range("A:A")) + 1, 1) = Date
    sk.Cells(WorksheetFunction.CountA(sk.Range("B:B")) + 1, 2) = qst
    sk.Cells(WorksheetFunction.CountA(sk.Range("C:C")) + 1, 3) = asw
    Next i
    'ねぎらいの言葉を書けるメッセージボックスを表示する
    MsgBox ("お疲れ様です!たまに集計データを見て戦績を振り返りましょう!")
End Sub

無事タイトルに問題数が追加されました。
ちなみに10問パターンはFor i =1 To 10に直せばOK。

ということで連続で大喜利お題が出題されるパターンは作れましたが、回答によっては入力するボックスが小さすぎる。スクロールしないと回答が全部自分で見えないのは嫌なので、次回はユーザーフォームを作成してよりよいインプットボックスを作ります。

この記事が気に入ったらサポートをしてみませんか?