子供のために筆算学習ツールを作ってみた

以前に100枡計算ツールを息子のために作ったのだが、学校で筆算を習うようになったので筆算のツールを作って欲しいとせがまれてしまった。

子供のリクエストとあらば答えねばなるまい！

完成品

完成品はこちらです。

足し算の動きはこんな感じです

引き算

掛け算

設定

使用するにあたって各種の設定を行います。

設定名	項目
計算種類	たしざん・ひきざん・かけざんから選択
オプション	現時点では引き算のみ設定あり。 ・答えがマイナスにならないように出題
上の段 下の段 最小値 最大値	出題される数値の範囲を設定します。 ０～９９９の間で設定することが出来ます。
問題数	出題される問題数を設定することが出来ます。 １～１００の間で設定することが出来ます

解答

スタートボタンを押すと出題され、解答モードになります。
解答モード中は解答入力欄（K５セル）とおわりボタン以外は触ることができなくなります。
そのため解答入力→Enter→解答入力とスムーズに進めることが出来ます。

指定した問題数を解答するか終わりボタンを押すことで解答モードが終了します。

解答履歴

解答モード中に解答するたびにこの欄に解答が一番上に蓄積されていきます。
○×の色は条件付き書式で設定しています。

コード

今回はセルに名前定義をしまくっています。
だいたいは名前を見ればどこを指しているかは解って頂けると思いますが、２つだけセルの文字を白色にして見えなくしています。
・解答数・・・現在何問目を解いているかを記載しています。
・解答中・・・解答モードの場合１を記載しています。

コードの構成はこうなっています。

以下はwsCalcワークシートに記載されています。

wsCalcワークシート

'スタートボタン
Private Sub CommandButton1_Click()
     With wsCalc
          If 問題判定 Then
               .Range("解答").Activate
               .Range("解答数").Value = ""
               '１で解答モードon。シートの保護機能をON。Range(”解答")以外はロックがかかっているため触れなくなる
               .Range("解答中").Value = 1
               .Range("解答履歴").ClearContents
               'スタートボタンを非アクティブにする
               .CommandButton1.Enabled = False
               
               '計算種類が選択されていない場合は「たしざん」が選ばれたとみなす
               If .Range("計算種類").Value = "" Then .Range("計算種類").Value = "たしざん"
               
               Select Case .Range("計算種類").Value
                    Case "たしざん"
                         .Range("下段出題").Offset(, -1).Value = "＋"
                    Case "ひきざん"
                         .Range("下段出題").Offset(, -1).Value = "ー"
                    Case "かけざん"
                         .Range("下段出題").Offset(, -1).Value = "×"
               End Select
               
               .Protect
               出題 .Range("計算種類").Value
          Else
               MsgBox "最小値を最大値以下に設定してください", vbInformation + vbOKOnly, "問題設定エラー"
          End If
     End With
End Sub
'------------------------------------------------------------'
'おわりボタン
Private Sub CommandButton2_Click()
     wsCalc.Unprotect
     wsCalc.Range("解答中").Value = ""
     wsCalc.Range("解答数").Value = ""
     wsCalc.CommandButton1.Enabled = True
End Sub
'------------------------------------------------------------'
Private Sub Worksheet_Change(ByVal Target As Range)
     'セル内容を変更したセルのアドレスがRange("解答")のアドレスと一致、かつ解答中モード(スタートボタンを押した後)である場合
     If Target.Address = Range("解答").Address And wsCalc.Range("解答中").Value = 1 Then
          wsCalc.Range("解答").Activate
          出題 wsCalc.Range("計算種類").Value
     'セル内容を変更したセルのアドレスがRange("計算種類")のアドレスと一致した場合、オプション設定を初期化
     ElseIf Target.Address = Range("計算種類").Address Then
          Range("オプション").Value = ""
     End If
End Sub
'------------------------------------------------------------
'問題の設定のチェック
Private Function 問題判定() As Boolean
     Dim UeMax As Long
     Dim UeMin As Long
     Dim SitaMax  As Long
     Dim SitaMin As Long
     Dim tmp As Boolean
     tmp = True
     
     With wsCalc
          UeMax = .Range("上段最大値").Value
          UeMin = .Range("上段最小値").Value
          SitaMax = .Range("下段最大値").Value
          SitaMin = .Range("下段最小値").Value
     End With
     
'     上の段・下の段どちらかが最小値が最大値を上回っている場合にfalseを返す
     If UeMin > UeMax Or SitaMin > SitaMax Then
          tmp = False
     End If
     問題判定 = tmp
End Function

スタートボタンを押すとシート保護されます。 解答入力欄以外はロックがかかりますので解答欄以外にカーソルが行くことがありません。

標準モジュール

Option Explicit

Sub 出題(計算種類 As String)
     
Application.ScreenUpdating = False
Application.EnableEvents = False
     
     Dim QuestionNo As Long
     QuestionNo = wsCalc.Range("解答数").Value
     
     Call 解答履歴転記
     '設定問題数をクリアしたときの処理
     If QuestionNo = wsCalc.Range("問題数").Value Then
          MsgBox "全問終了しました！", vbInformation + vbOKOnly, "筆算マラソン終了"
          wsCalc.Unprotect
          wsCalc.CommandButton1.Enabled = True
          Range("解答中").Value = ""
          Range("解答数").Value = ""
          GoTo num1
     End If
     
'###出題処理
     Dim UeMax As Long
     Dim UeMin As Long
     Dim SitaMax  As Long
     Dim SitaMin As Long
     
     With wsCalc
          UeMax = .Range("上段最大値").Value
          UeMin = .Range("上段最小値").Value
          SitaMax = .Range("下段最大値").Value
          SitaMin = .Range("下段最小値").Value
     End With
     
     'それぞれの出題ロジックから上の段・下の段の出題数値を配列で受取る
     Dim 出題 As Variant
     Select Case 計算種類
          Case "たしざん"
               出題 = 足し算(SitaMin, SitaMax, UeMin, UeMax)
          Case "ひきざん"
               出題 = 引き算(SitaMin, SitaMax, UeMin, UeMax)
          Case "かけざん"
               出題 = 掛け算(SitaMin, SitaMax, UeMin, UeMax)
     End Select

     '上記で作成した問題数値をセルに転記
     With wsCalc
          .Unprotect
          .Range("解答").Value = ""
          .Range("上段出題").Value = 出題(0)
          .Range("下段出題").Value = 出題(1)
          .Range("解答数").Value = .Range("解答数").Value + 1
          .Protect
     End With
num1:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------------------
Private Function 足し算(下段最小値 As Long, 下段最大値 As Long, 上段最小値 As Long, 上段最大値 As Long) As Variant
     Dim UeQuestion As Long
     Dim SitaQuestion As Long
     
     UeQuestion = Fix(Rnd() * (上段最大値 - 上段最小値 + 1)) + 上段最小値
     SitaQuestion = Fix(Rnd() * (下段最大値 - 下段最小値 + 1)) + 下段最小値
     足し算 = Array(UeQuestion, SitaQuestion)
End Function
'---------------------------------------------------------------------------
Private Function 引き算(下段最小値 As Long, 下段最大値 As Long, 上段最小値 As Long, 上段最大値 As Long) As Variant
     Dim UeQuestion As Long
     Dim SitaQuestion As Long
     
     UeQuestion = Fix(Rnd() * (上段最大値 - 上段最小値 + 1)) + 上段最小値
     SitaQuestion = Fix(Rnd() * (下段最大値 - 下段最小値 + 1)) + 下段最小値
     
     If wsCalc.Range("オプション").Value = "答えがマイナスにならないように出題" And SitaQuestion > UeQuestion Then
          Dim tmp As Long
          tmp = UeQuestion
          UeQuestion = SitaQuestion
          SitaQuestion = tmp
     End If
     引き算 = Array(UeQuestion, SitaQuestion)
End Function
'---------------------------------------------------------------------------
Private Function 掛け算(下段最小値 As Long, 下段最大値 As Long, 上段最小値 As Long, 上段最大値 As Long) As Variant
     Dim UeQuestion As Long
     Dim SitaQuestion As Long
     UeQuestion = Fix(Rnd() * (上段最大値 - 上段最小値 + 1)) + 上段最小値
     SitaQuestion = Fix(Rnd() * (下段最大値 - 下段最小値 + 1)) + 下段最小値
     
     掛け算 = Array(UeQuestion, SitaQuestion)
End Function
'---------------------------------------------------------------------------
'###解答後の処理
Sub 解答履歴転記()
     Const AnsHistoryStratRow As Long = 4
     Dim QuestionNo As Long
     
     With wsCalc
          QuestionNo = .Range("解答数").Value
              
          '解答履歴の転記
          If QuestionNo >= 1 Then
               .Unprotect
               
               Dim AnsHistory As Variant
               
               '2問目以降の解答の場合解答履歴欄に記載されている履歴を1段下にずらす
               If QuestionNo >= 2 Then
                    AnsHistory = .Range(Cells(AnsHistoryStratRow + 1, 14), Cells(AnsHistoryStratRow + QuestionNo - 1, 20)).Value
                    .Cells(AnsHistoryStratRow + 2, 14).Resize(UBound(AnsHistory), UBound(AnsHistory, 2)).Value = AnsHistory
               End If
               
               .Cells(AnsHistoryStratRow + 1, 14).Value = QuestionNo
               .Cells(AnsHistoryStratRow + 1, 15).Value = .Range("上段出題").Value
               .Cells(AnsHistoryStratRow + 1, 16).Value = .Range("下段出題").Offset(, -1).Value
               .Cells(AnsHistoryStratRow + 1, 17).Value = .Range("下段出題").Value
               .Cells(AnsHistoryStratRow + 1, 18).Value = "="
               .Cells(AnsHistoryStratRow + 1, 19).Value = .Range("解答").Value
               .Cells(AnsHistoryStratRow + 1, 20).Value = 正誤判定(.Range("計算種類").Value, .Range("上段出題").Value, _
                    .Range("下段出題").Value, .Range("解答").Value)
     
               .Protect
          End If
     End With
End Sub
'---------------------------------------------------------------------------
Private Function 正誤判定(計算種類 As String, 上段出題 As Long, 下段出題 As Long, 解答 As Variant) As String
     Dim tmp As Boolean
     tmp = False
     Select Case 計算種類
          Case "たしざん"
               If 解答 = 上段出題 + 下段出題 Then tmp = True
          Case "ひきざん"
               If 解答 = 上段出題 - 下段出題 Then tmp = True
          Case "かけざん"
               If 解答 = 上段出題 * 下段出題 Then tmp = True
     End Select
     
     If tmp Then
          正誤判定 = "○"
     Else
          正誤判定 = "×"
     End If
End Function

今回は関数名にも変数にも日本語を使いまくりました。
その方が読みやすい気がしたからです。
（こういうのを英語で表現する練習もしたほうが良い気もしますが

「出題」はスタートボタンを押した時と解答欄に入力されたときに使用されます。
解答履歴への転記・各種問題機能の呼び出しを担当しています。

「足し算」・「引き算」・「掛け算」はそれぞれ出題を担当しています。
引き算のみオプション対応が必要なため処理内容が異なっています。
現時点では足し算・掛け算は処理内容が同じですが、将来のオプション処理対応のため分けています。

それぞれの処理は返り値として上段の出題数・下段の出題数値を配列で返します。

解答履歴転記は
・問題番号
・出題の上の段の数字
・計算記号（＋ー×）
・出題の下の段の数字
・解答
を履歴欄に転記していきます。
これは下にドンドン追加していくと最新の解答の正誤が画面外にいってしまって見えなくなるのを防ぐためです。

正誤判定は解答が正しいかどうかの判定を行っています。

まとめ

取り敢えずここまで作っておけばしばらくは大丈夫でしょう。
しかしまだまだ遠慮を知らない息子から、情け容赦無い改善要望が出るたびにブラッシュアップしていきたいと思います。