4択クイズ実行プログラム ver.0.1

Option Explicit
Dim CorrectAns

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日へ
    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()
    Dim rowNo
    rowNo = Int(Rnd * Sheet1.UsedRange.Rows.Count + 1)
    quizText.Text = Sheet1.Cells(rowNo, 2)
    
'問題ナンバーを入力する行番号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 = "○ 正解"
        Sheet2.Range("B" & n).Value = "1" '記録用シートに正答を記録する
    Else
        info.Caption = "× 不正解"
        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