大喜利マクロを作ろう②

気づいたらママタルトひわちゃんのnoteが更新されていて、「ママタルト檜原のご機嫌スタンプ」なるLINEスタンプが発売されていることを知り衝動買いをした。

これで私が買ったLINEスタンプは計5種。すごいよマサルさんのスタンプ2種とピューと吹く!ジャガーのスタンプ2種とママタルト檜原のご機嫌スタンプ。ひわちゃんってうすた京介作品だったのか。

さて、大喜利マクロの続きですが、前回言ったとおりいまいちお題のインプットボックスがいまいち。

①インプットボックスの仕様を変更
まずはInputBox関数の構文を確認。
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
ちょっとよく分からないのでそれぞれ説明を見ていこう。

prompt
ダイアログ ボックス内にメッセージとして表示する文字列を示す文字列式を指定(最大約 1,024 文字)
title
ダイアログ ボックスのタイトル バーに表示する文字列式を指定
default
ユーザーが何も入力しない場合に、テキスト ボックスに既定値として表示する文字列式を指定
xpos
画面の左端からダイアログ ボックスの左端までの水平方向の距離を、twip単位で示す数式を指定
ypos
画面の上端からダイアログ ボックスの上端までの垂直方向の距離を、twip単位で示す数式を指定
helpfile
ダイアログ ボックスに状況依存のヘルプを設定するために、使用するヘルプ ファイルの名前を示す文字列式を指定
context
ヘルプ トピックに指定したコンテキスト番号を表す数式を指定

・・・まぁtitleを追加するだけでいいか。

Sub お題表示()
    '乱数系列初期化
    Randomize
    'Long型変数mに大喜利お題シートのA列でデータが入力されている最終行の番号を代入
    Dim m As Long: m = Cells(Worksheets("大喜利お題").Rows.Count, 1).End(xlUp).Row
    'Long型変数nにデータがあるセルの範囲内で行番号をランダム生成した数字を代入
    Dim n As Long: n = Int((m - 1 + 1) * Rnd + 1)
    '大喜利のお題を代入するString型変数を宣言する
    Dim question As String
    'ランダムで選ばれたお題を変数に代入する
    question = Cells(n, 1)
    '大喜利の回答を集計するためのString型変数を宣言する
    Dim answer As String
    'ランダムで大喜利お題を出題するインプットボックスを表示し上の変数に代入
    answer = InputBox(question, "お題")

タイトルに「お題」って出しただけですが、まぁいいでしょう!

②回答データを集計するテーブルを作成
集計のルールどうしようかなぁと悩んだが、回答日ごとにお題と回答が集計されるかたちでまとめていこうと思う。
ブックに「集計」シートを追加して、「回答日」、「お題」、「回答」の項目を設定する。

とりあえずこんな感じ。
あとは各テーブルに項目が入るようにコードを設定します。

③「回答日」、「お題」、「回答」が「集計」テーブルに入力されるようにする
使うシートが複数になるとアクティブなシートがどれか気を付けないといけなくなって面倒。しかし、ちゃんとシートを指定する命令をWorksheets("大喜利お題")みたいに書くのも面倒。
ということでプログラムの冒頭でSet命令を使って手間を省こうと思います!


Sub お題表示()
    '「大喜利お題」シート、「集計」シートを代入する変数を宣言する
    Dim od As Worksheet
    Dim sk As Worksheet
    '「大喜利お題」シート、「集計」シートを変数に代入
    Set od = Worksheets("大喜利お題")
    Set sk = Worksheets("集計")
    '乱数系列初期化
    Randomize
    'Long型変数mに大喜利お題シートの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)
    '大喜利のお題を代入するString型変数を宣言する
    Dim qst As String
    'ランダムで選ばれたお題を変数に代入する
    qst = od.Cells(n, 1)
    '大喜利の回答を集計するためのString型変数を宣言する
    Dim asw As String
    'ランダムで大喜利お題を出題するインプットボックスを表示し上の変数に代入
    asw = InputBox(qst, "お題")
End Sub

こんな感じでしょうか。あとは「集計」シートに「回答日」、「お題」、「回答」が入るようにしましょう!

    '回答日、お題、回答を「集計」シートに当てはまるように代入していく。
    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

これでとりあえず基礎工事は完成かな。動かしてみましょう。

Sub お題表示()
    '「大喜利お題」シート、「集計」シートを代入する変数を宣言する
    Dim od As Worksheet
    Dim sk As Worksheet
    '「大喜利お題」シート、「集計」シートを変数に代入
    Set od = Worksheets("大喜利お題")
    Set sk = Worksheets("集計")
    '乱数系列初期化
    Randomize
    'Long型変数mに大喜利お題シートの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)
    '大喜利のお題を代入するString型変数を宣言する
    Dim qst As String
    'ランダムで選ばれたお題を変数に代入する
    qst = od.Cells(n, 1)
    '大喜利の回答を集計するためのString型変数を宣言する
    Dim asw As String
    'ランダムで大喜利お題を出題するインプットボックスを表示し上の変数に代入
    asw = InputBox(qst, "お題")
    '回答日、お題、回答を「集計」シートに当てはまるように代入していく。
    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
End Sub

成功しました!
次回以降、For文などを使って、大喜利連続10問くらい出る仕組みを作っていきます。

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