【Excel VBA 練習】VBAで計算ドリルを作成する

VBAの練習として、計算ドリルを作ってみました。

【目次】

計算ドリルの使い方の説明

以下のような計算ドリル用のExcelのシートになっています。

■問題の種類選択
問題の種類選択のセルE2が「加算、減算、乗算、除算」のリストになっていて、問題の種類を選択できます。

■回答開始
「回答開始」をクリックすると問題が作成されます。
メッセージボックスで「OK」を選択すると、セルH2に開始時間が入力されます。
この状態でG列に回答を入力していきます。
※「回答開始」ボタンを押すと、前回の問題、回答、正解、得点、開始時間、終了時間、かかった時間がクリアされて、新しい問題が作成されます。
※「回答開始」ボタンは四角形の図形にマクロ(calculationDrill)を登録しています。

■回答終了・採点
回答が終わったら、「採点」ボタンを押します。採点ボタンを押すとセルH9:H28までに正解なら「○」、不正解なら正しい値が入力されます。
セルH29に得点が入力されます。
セルH3:H4には「採点」ボタンを押した時間と、開始時間から終了時間までの時間が入力されます。
※「採点」ボタンは四角形の図形にマクロ(calculationDrill)が登録されています。

■注意点
除算の場合は割り切れない問題があります。
その場合は、小数点第2位以下を切り捨てた、小数点第1位までの値を正解とします。

■「クリア」ボタン
「クリア」ボタンは、問題、回答、得点、開始時間、終了時間、かかった時間をクリアするボタンです。
「クリア」ボタンは四角形の図形にマクロ(dataClear)というマクロが登録されています。

計算ドリルのVBAのコード

以下のようなコードを書きました。

Sub calculationDrill()
    
    Call dataClear
    
    '最終行の取得
    Dim maxCol As Long: maxCol = Cells(Rows.Count, 2).End(xlUp).Row
    
    '問題の種類、演算子の入力
    Dim strKind As String: strKind = Cells(2, 5)
    Dim strBuff As String
    
    Select Case strKind
        Case "加算"
            strBuff = "＋"
        Case "減算"
            strBuff = "－"
        Case "乗算"
            strBuff = "×"
        Case "除算"
            strBuff = "÷"
    End Select
    
    '問題の種類に応じた演算子を入力
    Dim i As Long
    
    For i = 9 To maxCol
        Cells(i, 3) = Int(Rnd() * 10) + 1
        Cells(i, 4) = strBuff
        Cells(i, 5) = Int(Rnd() * 10) + 1
        Cells(i, 6) = "="
    Next i

    MsgBox "Start", vbOKOnly, "計算問題"
    Cells(2, 8) = Now()
       
End Sub


Sub pickingPoints()
    
    '終了時間、かかった時間の取得
    Cells(3, 8) = Now()
    Cells(4, 8) = Cells(3, 8) - Cells(2, 8)

    '最終行の取得
    Dim maxCol As Long: maxCol = Cells(Rows.Count, 2).End(xlUp).Row
      
    Dim i As Long
    Dim lScore As Long
    
    For i = 9 To maxCol
        Cells(i, 8) = "=" & Cells(i, 3) & Cells(i, 4) & Cells(i, 5)
        Cells(i, 8).Value = Application.WorksheetFunction.RoundDown(Cells(i, 8).Value, 1)
        
        If Cells(i, 8) = Cells(i, 7) Then
            Cells(i, 8) = "○"
            lScore = lScore + 5
        Else
            Cells(i, 8).Font.Color = RGB(255, 0, 0)
        End If
    Next i

    Cells(29, 8) = lScore
    If Cells(29, 8) < 70 Then
        Cells(29, 8).Font.Color = RGB(255, 0, 0)
        MsgBox lScore & "点です。頑張りましょう！"
    Else
        MsgBox lScore & "点です。よくできました！"
    End If

End Sub


Sub dataClear()
    Range("C9:H28").ClearContents
    Range("H2:H4").ClearContents
    Range("H29").ClearContents
    Range("H9:H29").Font.Color = RGB(0, 0, 0)
End Sub

もしよければ試してみてください。
以上、お読みいただきありがとうございました。