Excelが大好きだ!

Excel大好き経理マンがExcelの事を書き綴っていきます。


スポンサードリンク

子供のために作った筆算学習ツールを割り算対応にした

先日作成したこちらの筆算の学習ツール。
www.excellovers.com

足し算・引き算・掛け算までは出来ていたのですが、勢いに任せて割り算対応もしてみました。

その過程でクライアント(嫁)から次々と要望が出てきましたが、何とか全て対応いたしました。

その時の応酬はこちら。

余談はコレくらいにして、本題に移ります。

完成品

こちらが完成品の操作画面です。

足し算(及び引き算・割り算) f:id:ExcelLover:20190505131437g:plain

割り算(文章問題表示)
f:id:ExcelLover:20190505131655g:plain

コード

wsCalcワークシート

Option Explicit
'スタートボタン
Private Sub CommandButton1_Click()
     With wsCalc
          If 問題判定 Then
               .Range("解答").Activate
               .Range("解答数").Value = ""
               '1で解答モードon。シートの保護機能をON。Range(”解答")以外はロックがかかっているため触れなくなる
               .Range("解答中").Value = 1
               .Range("解答履歴").ClearContents
               'スタートボタンを非アクティブにする
               .CommandButton1.Enabled = False
               
               '計算種類が選択されていない場合は「たしざん」が選ばれたとみなす
               If .Range("計算種類").Value = "" Then .Range("計算種類").Value = "たしざん"
               
’①筆算のフォーマット調整                
               Select Case .Range("計算種類").Value
                    Case "たしざん"
                         .Range("計算記号").Value = "+"
                         割り算以外表示リセット
                         
                    Case "ひきざん"
                         .Range("計算記号").Value = "ー"
                         割り算以外表示リセット
                         
                    Case "かけざん"
                         .Range("計算記号").Value = "×"
                         割り算以外表示リセット
                         
                    Case "わりざん"
                         .Range("計算記号").Value = ""
                         .Range("計算記号").Offset(1).Value = "あまり"
                         .Range("商").Locked = False
                         .Range("商").Activate
                         .Range("商").Borders(xlEdgeBottom).LineStyle = xlContinuous
                         .Range("商").Borders(xlEdgeBottom).Weight = xlMedium
                         Shapes("Arc 1").Line.ForeColor.RGB = RGB(0, 0, 0)
               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)
     If Target.Address = Range("解答").Address And wsCalc.Range("計算種類") = "わりざん" And wsCalc.Range("解答中").Value = 1 Then
          wsCalc.Range("商").Activate
          出題 wsCalc.Range("計算種類").Value
     ElseIf Target.Address = Range("解答").Address And wsCalc.Range("解答中").Value = 1 Then
          wsCalc.Range("解答").Activate
          出題 wsCalc.Range("計算種類").Value
     ElseIf Target.Address = Range("計算種類").Address Then
          If Range("計算種類").Value = "わりざん" Then
               Range("オプション").Value = "商と余りで解答"
          ElseIf Range("計算種類").Value = "ひきざん" Then
               Range("オプション").Value = "答えがマイナスにならないように出題"
          Else
               Range("オプション").Value = ""
          End If
     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
'----------------------------------------------
Private Sub 割り算以外表示リセット()
     With wsCalc
          .Range("計算記号").Offset(2).Value = ""
          .Range("計算記号").Offset(1).Value = ""
          .Range("商").Borders(xlEdgeBottom).LineStyle = xlNone
          .Range("商").Locked = True
          Shapes("Arc 1").Line.ForeColor.RGB = RGB(255, 255, 255)
     End With
End Sub

割り算のみ他の四則演算と筆算の形式が違うため、一気に対応が複雑化しました。

①割り算なしの場合は計算記号(+、ー、×)の調整のみで済んだことが、そもそも筆算の表示が割り算のみ異なっているため、別の対応が必要になりました。

・解答入力セルが1ヶ所だったのが2ヶ所に増加。

・計算記号の表示位置、表示方法が異なる。

1つ目に関しては商の部分のセルの保護を割り算のときのみ解除することで対応

2つ目に関しては罫線の追加とオートシェイプの塗り潰しの有無で対応

標準モジュール

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)
          Case "わりざん"
               出題 = 割り算(SitaMin, SitaMax, UeMin, UeMax)
          Case Else
               MsgBox "計算種類が正しく選択されていません", vbCritical + vbOKOnly, "選択エラー"
               GoTo num1
     End Select

'①文章問題の作成
     Dim QuestionStr As String
     
     Select Case 計算種類
          Case "たしざん"
               QuestionStr = "グミを『" & 出題(0) & "こ』もっています。" & vbCrLf & vbCrLf & "おかあさんが『" & 出題(1) & "こ』くれました。" & vbCrLf & vbCrLf & "ぜんぶでなんこもってるでしょうか?"
          Case "ひきざん"
               QuestionStr = "グミを『" & 出題(0) & "こ』もっています。" & vbCrLf & vbCrLf & "おかあさんに『" & 出題(1) & "こ』あげました。" & vbCrLf & vbCrLf & "ぜんぶでなんこもってるでしょうか?"
          Case "かけざん"
               QuestionStr = "グミを『" & 出題(0) & "にん』が" & vbCrLf & vbCrLf & "『" & 出題(1) & "こ』ずつもっています。" & vbCrLf & vbCrLf & "ぜんぶでなんこもってるでしょうか?"
          Case "わりざん"
               QuestionStr = "グミ『" & 出題(0) & "こ』を" & vbCrLf & vbCrLf & "『" & 出題(1) & "にん』でわけわけしました。" & vbCrLf & vbCrLf & "ひとりがなんこもっていて" & vbCrLf & vbCrLf & "なんこあまったでしょうか?"
          Case Else
          
     End Select
          
     '上記で作成した問題数値をセルに転記
     With wsCalc
          .Unprotect
          .Range("H9").Comment.Text QuestionStr
          .Range("解答").Value = ""
          .Range("商").Value = ""
          .Range("商下段出題").Value = ""
          .Range("下段出題").Value = ""
          .Range("上段出題").Value = 出題(0)
          If .Range("計算種類").Value = "わりざん" Then
               .Range("商下段出題").Value = 出題(1)
          Else
               .Range("下段出題").Value = 出題(1)
          End If
          .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
'----------------------------------------------
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, 21)).Value
                    .Cells(AnsHistoryStratRow + 2, 14).Resize(UBound(AnsHistory), UBound(AnsHistory, 2)).Value = AnsHistory
               End If
               
               Dim UeQuestion As Long
               Dim SitaQuestion As Long
               Dim Answer As Long
               Dim DivisionMod As Variant
               Dim MathematicalSymbols As String

’②割り算の余り追加への対応            
               UeQuestion = .Range("上段出題").Value
               If .Range("計算種類").Value = "わりざん" Then
                    SitaQuestion = .Range("商下段出題").Value
                    Answer = .Range("商").Value
                    DivisionMod = .Range("解答").Value
                    MathematicalSymbols = "÷"
               Else
                    SitaQuestion = .Range("下段出題").Value
                    Answer = .Range("解答").Value
                    MathematicalSymbols = .Range("計算記号").Value
               End If
               
               .Cells(AnsHistoryStratRow + 1, 14).Value = QuestionNo
               .Cells(AnsHistoryStratRow + 1, 15).Value = UeQuestion
               .Cells(AnsHistoryStratRow + 1, 16).Value = MathematicalSymbols
               .Cells(AnsHistoryStratRow + 1, 17).Value = SitaQuestion
               .Cells(AnsHistoryStratRow + 1, 18).Value = "="
               .Cells(AnsHistoryStratRow + 1, 19).Value = Answer
               .Cells(AnsHistoryStratRow + 1, 20).Value = DivisionMod
               .Cells(AnsHistoryStratRow + 1, 21).Value = 正誤判定(.Range("計算種類").Value, UeQuestion, _
                    SitaQuestion, Answer, DivisionMod)
     
               .Protect
          End If
     End With
End Sub
'----------------------------------------------
Private Function 正誤判定(計算種類 As String, 上段出題 As Long, 下段出題 As Long, 解答 As Variant, Optional 解答余り 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
          Case "わりざん"
               If wsCalc.Range("オプション").Value = "商と余りで解答" Then
                    DimAs Long
                    DimAs Long= 上段出題 \ 下段出題
                    余 = 上段出題 Mod 下段出題
                    If 解答 =And= 解答余り Then tmp = True
               Else
                    If 解答 = 上段出題 / 下段出題 Then tmp = True
               End If
     End Select
     
     If tmp Then
          正誤判定 = "○"
     Else
          正誤判定 = "×"
     End If
End Function

標準モジュール側も割り算追加の影響で複雑化しています。

①想定外の内容ですが、クライアント(嫁)の要望で追加しました。計算種類によって文言を変えるようにしました。ベースが出来たのでそれぞれの計算についてレパートリーを増やすことも可能です。

②列の追加と「正誤判定」関数内に割り算の対応を追加しました。

まとめ

現時点では割り算は商と余りで表現する解答にしか対応していません。

ただこの方式で解答する以上は小数点以下の解答に対応する必要はないのかもしれませんが。

今後のクライアント(嫁、息子)の依頼次第といったところです。

これで小学校4年生くらいまでは使えるのかな。