【Excel VBA】四択クイズのプログラムで重複した問題を出題させないようにしたい

前提

以下のサイトに記載のVBAコードで、四択問題を出し、正誤の結果を記録するプログラムを作成します。

試験勉強に最適な「Excel 4択クイズ実行プログラム」

プログラムの概要は以下の通りです。

  1. Sheet1に問題と選択肢、解説を入力する。(A列:問題番号、B列:問題文、C列:選択肢(正答)、D~F列:選択肢(誤答)、G列:解説文
  2. Sheet2のボタンを押してプログラムを実行するとフォームが表示される。
  3. 「スタート」をクリックする。
  4. 入力した問題がランダムに実行される。選択肢の位置もランダム表示される。
  5. 4つの選択肢ボタンを押して答えを選ぶ。
  6. 正答か誤答かフィードバックされる。(入力していれば、解説も表示される)
  7. 次の問題に進むかどうか聞かれる。
  8. 「はい」→④に戻り、くり返す。「いいえ」→出題を終了する。
  9. 日付、正答率、問題番号と正誤を記録する。Sheet3の「データ処理」ボタンを押すと問題番号順に正誤の結果が並び替えられる。重複データは削除され、正答と誤答どちらを優先するかも変更できる。

作成したフォームは下の画像の通りです。

イメージ説明
オレンジは、各要素のオブジェクト名や大きさ等を示しています。このオブジェクトを元にコードを入力します。

実現したいこと

掲載されたコードの通りに作成してプログラムは問題なく実行できましたが、実際に使ってみると、同じ問題が何度も出題される上、⑧で「いいえ」を選択しないとプログラムを終了できない、と不便さを感じました。
そこで今度は⑧と⑨の手順の間に次の手順を追加したいです。

  1. 次の問題に進む時に既出の問題を重複して出題しないようにする
  2. 全ての問題が出題されたら、出題を強制終了する

該当のソースコード

フォーム内に記載したコードは以下の通りです。「フォームの実行」と「データ処理」のコードはここでは省略します。

VBA

1Option Explicit 2Dim CorrectAns, CmntRow 3 4Private Sub UserForm_Initialize() 5 info.Visible = False 6End Sub 7 8Private Sub ToggleButton5_Click() 9 setQuizData 10 11'保存用シートへのデータ貼りつけ用の最終列取得の次の列i 12 Dim i 13 i = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column 14 If Sheet3.Cells(1, i).Value <> "" Then i = i + 1 'A1が空白ならiを1とする 15 16'記録用シートに日付を入力する 17Sheet2.Range("A1").Value = Date 18Sheet2.Range("B1").Value = "%" '後に正答率を入力する 19 20Do 21 While info.Visible = False 22 DoEvents 23 Wend 24 25 Dim nextQuiz 26 nextQuiz = MsgBox("次の問題に進みますか?", vbInformation + vbYesNo) 27 If nextQuiz = vbYes Then 28 info.Visible = False 29 setQuizData 30 Else 31 Exit Do 32 End If 33 34 Loop 35 Sheet2.Range("A1").CurrentRegion.Copy 'Sheet2のデータをコピー 36 'Sheet3に貼りつけ 37 Sheet3.Cells(1, i).PasteSpecial Paste:=xlPasteValues, _ 38 Operation:=xlNone, SkipBlanks:=False, Transpose:=False 39 Sheet3.Cells(1, i).NumberFormatLocal = "mm/dd" '表示形式を00月00日へ 40 Sheet3.Cells(1, i + 1).NumberFormatLocal = "0%" '表示形式をパーセントへ 41 Sheet2.Cells.Clear '記録用シートの初期化 42 43 Call getAverage(i) 44 45 MsgBox "問題集を終了します", vbInformation + vbOKOnly 46 Unload Me 47End Sub 48 49Private Sub getAverage(ByVal lBeginCol As Long) 50 51 Const TARGET_SHEET_NAME As String = "Sheet3" 52 Const COL_OFFSET As Long = 2 53 Dim sHeader As String 54 Dim lCol As Long 55 Dim lEndRow As Long 56 Dim lTargetCol As Long 57 58 lCol = lBeginCol 59 60 With ThisWorkbook.Worksheets(TARGET_SHEET_NAME) 61 sHeader = .Cells(1, lCol).Value 62 63 Do Until sHeader = "" 64 lEndRow = .Cells(1, lCol).End(xlDown).Row 65 66 lTargetCol = lCol + 1 67 68 .Cells(1, lTargetCol).Value = WorksheetFunction.Average(.Range(.Cells(2, lTargetCol), .Cells(lEndRow, lTargetCol))) 69 70 lCol = lCol + COL_OFFSET 71 72 sHeader = .Cells(1, lCol).Value 73 Loop 74 End With 75End Sub 76 77Private Sub setQuizData() 78 79 Randomize '乱数ジェネレータを初期化 80 Dim rowNo 81 rowNo = Int(Rnd * Sheet1.UsedRange.Rows.Count + 1) 82 quizText.Text = Sheet1.Cells(rowNo, 2) 83 CmntText.Text = "" 84 85'rowNoは問題の行数 86'解説を表示するためにrowNoを記録しておく 87 CmntRow = rowNo 88 89'問題ナンバーを入力する行番号mを定義 90Dim m 91 m = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1 92 ans1.Value = False 93 ans2.Value = False 94 ans3.Value = False 95 ans4.Value = False 96 97 ans1.Caption = "" 98 ans2.Caption = "" 99 ans3.Caption = "" 100 ans4.Caption = "" 101 102'変数の説明 103'ansFlag: いくつ選択肢を設定したのかを記憶しておく箱 104'ansNo: 1から4の間で発生させた乱数の値を記憶しておく箱 105'colNo: Sheet1の3列目から6列目に格納されている選択肢の、何番目までを設定したのかを記憶しておく箱 106 107 Dim ansFlag, ansNo, colNo 108 ansFlag = 0 109 ansNo = 0 110 colNo = 3 111 While ansFlag < 4 'ansFlagが4より小さいあいだ処理をくり返す 112 ansNo = Int(Rnd * 4 + 1) '0~1までの乱数Rnd に4をかけ、1を足し、小数点以下を切り捨てるInt 113 If UserForm1.Controls("ans" & ansNo).Caption = "" Then 114 UserForm1.Controls("ans" & ansNo).Caption = Sheet1.Cells(rowNo, colNo) 115 ansFlag = ansFlag + 1 116 117 Sheet2.Range("A" & m).Value = Sheet1.Cells(rowNo, 1) '記録シートに問題番号を入力 118 119 '正答(Sheet1の3列目)がどのトグルボタンに設定されたかをCorrectAnsに記憶 120 If colNo = 3 Then 121 CorrectAns = ansNo 122 End If 123 colNo = colNo + 1 124 End If 125 Wend 126 127End Sub 128 129Private Sub answerJudg(tName) 130Dim n 131 n = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row + 1 132 133 If UserForm1.Controls("ans" & tName).Value = False Then 134 Exit Sub 135 End If 136 137 If CorrectAns = tName Then 138 info.Caption = "○ 正解" 139 CmntText = Sheet1.Cells(CmntRow, 7) 140 Sheet2.Range("B" & n).Value = "1" '記録用シートに正答を記録する 141 Else 142 info.Caption = "× 不正解" 143 CmntText = Sheet1.Cells(CmntRow, 7) 144 Sheet2.Range("B" & n).Value = "0" '記録用シートに誤答を記録する 145 146 End If 147 info.Visible = True 148End Sub 149 150Private Sub ans1_Click() 151 answerJudg (1) 152End Sub 153 154Private Sub ans2_Click() 155 answerJudg (2) 156End Sub 157 158Private Sub ans3_Click() 159 answerJudg (3) 160End Sub 161 162Private Sub ans4_Click() 163 answerJudg (4) 164End Sub

試したこと

重複してしまう原因はsetQuizData()内のRandomizeでルーチンを初期化しているのが原因かと思います。
次の問題に進む時、問題の参照にiを使わず、rowNoにセットする値を工夫する事で、未出題か出題済みか判定するような処理を書けば、問題の重複を避けられるかな、と考えています。
ただ参考になるサイトが見つからず具体的にどんなコードを書けばいいかわからない状況です。
回答となるコードを丸ごといただければ勿論うれしいですが、それだけでは今後の勉強にならないので、考え方やヒントをいただければ幸いです。
よろしくお願いいたします。

コメントを投稿

0 コメント