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

　資格試験の主な勉強方法の１つは、過去問を解くことです。しかし、書籍や紙の問題集では、正答率の計算や苦手な問題の把握に手間がかかります。そこで、問題を自分自身に出し、正誤の結果を記録する Excel VBA のプログラムを作成しました。本エントリでは、プログラムの概要を説明し、VBA コードを提供します。

プログラムの概要

 このプログラムでは、エクセルで以下のことができます。
① エクセルに問題と回答選択肢（解説）を入力します。

　　A列：問題番号
　　B列：問題文
　　C列：選択肢（正答）
　　D~F列：選択肢（誤答）
　　G列：解説文

②プログラムを実行するとフォームが表示されます。

③「スタート」をクリック
④入力した問題がランダムに実行されます。回答選択肢の位置もランダムです。

⑤答えを選ぶ
⑥正答か誤答かがフィードバックされる。（入力していれば、解説も表示される）
⑦次の問題に進むかどうかを聞かれる

⑧「はい」→④に戻り、くり返し
　「いいえ」→問題の終了
⑨日付け、正答率、問題番号と正誤（誤答=0、正答=1）のデータが記録される。
　「データ処理」ボタンを押すと問題番号順に正誤の結果が並び替えられる。
　（重複データは削除される。正答と誤答のどちらを優先するかも変更はできる）

 プログラム作成の手順

 本プログラムは、VBA (Visual Basic for Applications) というプログラミング言語で書かれています。エクセルでこのプログラムを実行するためには、以下のように設定を変更する必要があります。
Excelメニュー［ファイル］→［オプション］ → ［リボンのユーザー設定］→ ［メインタブ］内の［開発］にチェックをつけ［OK］ → Excelのメニューに［開発］タブが追加される。
ファイルの保存は [名前を付けて保存] → ファイルの種類で[Excel マクロ有効ブック(*.xlsm)]を選択して保存する。セキュリティ警告の「コンテンツの有効化」をクリックする（詳しくは以下のリンク参照）。これで準備完了です。
Excelマクロ機能の基本操作（2007/2010/2013版）
Excelマクロ機能の基本操作（2007/2010/2013版）(3ページ目)
[開発タブ] → [Visual Basic] とクリックします。

尚、本プログラムは、以下のHPを主に参考に作成しています。
女子大生のためのExcelVBA講座

Sheetの準備
Sheet 2, Sheet 3 を新規作成します。このシートには何も入力しなくて良いです。

フォームの作成
[Sheet 1]を右クリック → [挿入] → [ユーザーフォーム] を選択する。以下のHPの手順に沿って作成してください。
Lesson4：ユーザフォームの作成
上のリンクでは、ボタンは5つですが、本プログラムは４つです。また、解説用のテキストボックスも加え、以下のようになります。

オレンジでは、各要素のオブジェクト名や大きさを示しています。オブジェクト名を間違えないように、入力してください。

コードウィンドウを開くために、作成した [スタート] ボタンをダブルクリックします。

コードウィンドウで「全体を選択 [Alt] + [A]」し、デリーとします。そして、以下のコードを貼りつけます。

	Option Explicit
	Dim CorrectAns, CmntRow
	Private Sub UserForm_Initialize()
	info.Visible = False
	End Sub
	Private Sub ToggleButton5_Click()
	setQuizData
	'保存用シートへのデータ貼りつけ用の最終列取得の次の列i
	Dim i
	i = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column
	If Sheet3.Cells(1, i).Value <> "" Then i = i + 1 'A1が空白ならiを1とする
	'記録用シートに日付を入力する
	Sheet2.Range("A1").Value = Date
	Sheet2.Range("B1").Value = "％" '後に正答率を入力する
	Do
	While info.Visible = False
	DoEvents
	Wend
	Dim nextQuiz
	nextQuiz = MsgBox("次の問題に進みますか？", vbInformation + vbYesNo)
	If nextQuiz = vbYes Then
	info.Visible = False
	setQuizData
	Else
	Exit Do
	End If
	Loop
	Sheet2.Range("A1").CurrentRegion.Copy 'Sheet2のデータをコピー
	'Sheet3に貼りつけ
	Sheet3.Cells(1, i).PasteSpecial Paste:=xlPasteValues, _
	Operation:=xlNone, SkipBlanks:=False, Transpose:=False
	Sheet3.Cells(1, i).NumberFormatLocal = "mm/dd" '表示形式を00月00日へ
	Sheet3.Cells(1, i + 1).NumberFormatLocal = "0%" '表示形式をパーセントへ
	Sheet2.Cells.Clear '記録用シートの初期化
	Call getAverage(i)
	MsgBox "問題集を終了します", vbInformation + vbOKOnly
	Unload Me
	End Sub
	Private Sub getAverage(ByVal lBeginCol As Long)
	Const TARGET_SHEET_NAME As String = "Sheet3"
	Const COL_OFFSET As Long = 2
	Dim sHeader As String
	Dim lCol As Long
	Dim lEndRow As Long
	Dim lTargetCol As Long
	lCol = lBeginCol
	With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
	sHeader = .Cells(1, lCol).Value
	Do Until sHeader = ""
	lEndRow = .Cells(1, lCol).End(xlDown).Row
	lTargetCol = lCol + 1
	.Cells(1, lTargetCol).Value = WorksheetFunction.Average(.Range(.Cells(2, lTargetCol), .Cells(lEndRow, lTargetCol)))
	lCol = lCol + COL_OFFSET
	sHeader = .Cells(1, lCol).Value
	Loop
	End With
	End Sub
	Private Sub setQuizData()
	Randomize '乱数ジェネレータを初期化
	Dim rowNo
	rowNo = Int(Rnd * Sheet1.UsedRange.Rows.Count + 1)
	quizText.Text = Sheet1.Cells(rowNo, 2)
	CmntText.Text = ""
	'rowNoは問題の行数
	'解説を表示するためにrowNoを記録しておく
	CmntRow = rowNo
	'問題ナンバーを入力する行番号mを定義
	Dim m
	m = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1
	ans1.Value = False
	ans2.Value = False
	ans3.Value = False
	ans4.Value = False
	ans1.Caption = ""
	ans2.Caption = ""
	ans3.Caption = ""
	ans4.Caption = ""
	'変数の説明
	'ansFlag: いくつ選択肢を設定したのかを記憶しておく箱
	'ansNo: 1から4の間で発生させた乱数の値を記憶しておく箱
	'colNo: Sheet1の3列目から6列目に格納されている選択肢の、何番目までを設定したのかを記憶しておく箱
	Dim ansFlag, ansNo, colNo
	ansFlag = 0
	ansNo = 0
	colNo = 3
	While ansFlag < 4 'ansFlagが4より小さいあいだ処理をくり返す
	ansNo = Int(Rnd * 4 + 1) '0～1までの乱数Rnd に4をかけ、1を足し、小数点以下を切り捨てるInt
	If UserForm1.Controls("ans" & ansNo).Caption = "" Then
	UserForm1.Controls("ans" & ansNo).Caption = Sheet1.Cells(rowNo, colNo)
	ansFlag = ansFlag + 1
	Sheet2.Range("A" & m).Value = Sheet1.Cells(rowNo, 1) '記録シートに問題番号を入力
	'正答(Sheet1の3列目)がどのトグルボタンに設定されたかをCorrectAnsに記憶
	If colNo = 3 Then
	CorrectAns = ansNo
	End If
	colNo = colNo + 1
	End If
	Wend
	End Sub
	Private Sub answerJudg(tName)
	Dim n
	n = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row + 1
	If UserForm1.Controls("ans" & tName).Value = False Then
	Exit Sub
	End If
	If CorrectAns = tName Then
	info.Caption = "○ 正解"
	CmntText = Sheet1.Cells(CmntRow, 7)
	Sheet2.Range("B" & n).Value = "1" '記録用シートに正答を記録する
	Else
	info.Caption = "× 不正解"
	CmntText = Sheet1.Cells(CmntRow, 7)
	Sheet2.Range("B" & n).Value = "0" '記録用シートに誤答を記録する
	End If
	info.Visible = True
	End Sub
	Private Sub ans1_Click()
	answerJudg (1)
	End Sub
	Private Sub ans2_Click()
	answerJudg (2)
	End Sub
	Private Sub ans3_Click()
	answerJudg (3)
	End Sub
	Private Sub ans4_Click()
	answerJudg (4)
	End Sub

view raw Excel 4択クイズ実行プログラム Ver. 1.0 hosted with ❤ by GitHub

そして、標準モジュールにそれぞれ以下のコードを作成します。
Module １は、簡単に以下のコードです。

  Option Explicit

  Sub UserForm_Open()
  UserForm1.Show
  End Sub

Module 2 は、以下のコードを貼りつけてください。

	Option Explicit
	Private Const DATA_BEGIN_ROW As Long = 2
	Public Sub sortAndSerialize()
	Dim ws As Worksheet
	Dim lCol As Long
	Dim sDate As String
	Dim sCorrectAnswerRate As String
	Set ws = ThisWorkbook.ActiveSheet
	With ws
	lCol = ActiveCell.Column
	sDate = .Cells(1, lCol).Value
	Do Until sDate = ""
	If Not IsDate(sDate) Then
	Exit Do
	End If
	sCorrectAnswerRate = .Cells(1, lCol + 1).Value
	If sCorrectAnswerRate <> "" And (Not IsDate(sCorrectAnswerRate)) Then
	'並べ替え
	Call sortDatas(ws, lCol)
	'欠番挿入、重複番号削除
	Call toSerialize(ws, lCol)
	'日付移動、問題番号列削除
	Call deleteQNoCol(ws, lCol)
	End If
	lCol = lCol + 1
	sDate = .Cells(1, lCol).Value
	Loop
	End With
	End Sub
	Private Sub sortDatas(ByRef ws As Worksheet, ByVal lQNoCol As Long)
	Dim lEndRow As Long
	With ws
	lEndRow = .Cells(.Rows.Count, lQNoCol).End(xlUp).Row
	With .Sort.SortFields
	.Clear
	.Add Key:=ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol), ws.Cells(lEndRow, lQNoCol)), _
	SortOn:=xlSortOnValues, _
	Order:=xlAscending, _
	DataOption:=xlSortNormal
	'複数の異なる回答時：1を残す場合
	' .Add Key:=ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol + 1), ws.Cells(lEndRow, lQNoCol + 1)), _
	SortOn:=xlSortOnValues, _
	Order:=xlAscending, _
	DataOption:=xlSortNormal
	'複数の異なる回答時：0を残す場合
	.Add Key:=ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol + 1), ws.Cells(lEndRow, lQNoCol + 1)), _
	SortOn:=xlSortOnValues, _
	Order:=xlDescending, _
	DataOption:=xlSortNormal
	End With
	With .Sort
	.SetRange ws.Range(ws.Cells(DATA_BEGIN_ROW, lQNoCol), ws.Cells(lEndRow, lQNoCol + 1))
	.Header = xlNo
	.MatchCase = False
	.Orientation = xlTopToBottom
	.Apply
	End With
	End With
	End Sub
	Private Sub toSerialize(ByRef ws As Worksheet, ByVal lCol As Long)
	Dim lCurrentRow As Long
	Dim sCurrentQNo As String
	Dim lCurrentQNo As Long
	Dim lPrevQNo As Long
	Dim lInsertRows As Long
	lCurrentRow = DATA_BEGIN_ROW
	lPrevQNo = 0
	With ws
	sCurrentQNo = CStr(.Cells(lCurrentRow, lCol).Value)
	Do Until sCurrentQNo = ""
	lCurrentQNo = CLng(sCurrentQNo)
	If lCurrentQNo > lPrevQNo + 1 Then
	'欠番あり
	lInsertRows = lCurrentQNo - lPrevQNo - 1
	.Range(.Cells(lCurrentRow, lCol), .Cells(lCurrentRow + lInsertRows - 1, lCol + 1)).Insert Shift:=xlDown
	.Cells(lCurrentRow + lInsertRows, lCol).AutoFill Destination:=.Range(.Cells(lCurrentRow, lCol), .Cells(lCurrentRow + lInsertRows, lCol)), Type:=xlFillSeries
	With .Range(.Cells(lCurrentRow, lCol + 1), .Cells(lCurrentRow + lInsertRows - 1, lCol + 1))
	.NumberFormatLocal = "G/標準"
	End With
	lCurrentRow = lCurrentRow + lInsertRows + 1
	ElseIf lPrevQNo = lCurrentQNo Then
	'同番
	.Range(.Cells(lCurrentRow - 1, lCol), .Cells(lCurrentRow - 1, lCol + 1)).Delete Shift:=xlUp
	Else
	lCurrentRow = lCurrentRow + 1
	End If
	sCurrentQNo = CStr(.Cells(lCurrentRow, lCol).Value)
	lPrevQNo = .Cells(lCurrentRow - 1, lCol).Value
	Loop
	End With
	End Sub
	Private Sub deleteQNoCol(ByRef ws As Worksheet, ByVal lDateCol As Long)
	With ws
	.Cells(1, lDateCol + 1).Insert Shift:=xlDown
	.Cells(1, lDateCol).Copy Destination:=.Cells(1, lDateCol + 1)
	.Columns(lDateCol).Delete
	End With
	End Sub

view raw 回答データ整理プログラム hosted with ❤ by GitHub

このプログラムは、はてな人力検索にて、id:Z1000S  氏に書いていただきました。

Sheet2に「スタートボタン」、Sheet３に「データ処理ボタン」をそれぞれ作成します。

そして、スタートボタンにUserForm_Open()、データ処理ボタンにsortAndSerialize()のマクロを登録します。

以上でプログラムは完成です。

問題をSheet１に入力し、スタートボタンを押すと、クイズプログラムを実行できます。資格試験などに活用してみてください。