野性の証明

学校計算ドリルテスト

Excel VBAで四則演算のプログラムを作った。
１～４桁指定でき、最初テスト受験者を登録してから行う。

①resetボタンを押してください
②表示されたら実行を押してください
③Listに自分の名前があったらそれをクリックしてください
④赤の×をクリックしてください
⑤名簿に追加したいものがあればYesをそうでなければNoを
⑥Yesの時は入力してあるものを消してから自分の入力をしてください
⑦加減乗除を選択してください
⑧桁数を選択してください
⑨解答欄に答えを入れてください
⑩checkをクリックしてください
⑪青字が正解、赤字が不正解です
⑫Sheet2をクリックして自分の加減乗除、桁数欄に表示されています
⑬確認したら①に戻って他の加減乗除、桁をやってください
商を求める計算では 余りも正解でないと正解数には入れられません
ボタン2は関係ありません

Sub チェック()
Dim i As Long ‘カウンタ変数　※→「開発」→「マクロ」→「Module1」→「ツール」→「マクロ」→「チェック」→「編集」
Dim myTemporary As Long ‘あまりの処理
Dim myAmari As Long
Dim myGANS As Long ‘Counter Good Answer
Dim SRT_BS As Long ‘Displacement Count Area
Dim ST_PTR As Long ‘生徒のラインナンバー
Dim myANSWR As Boolean ‘割り算の商と余りが両方あってなければいけない
‘ Code
myGANS = 0 ‘Initialize
myANSWR = False
Sheets(“Sheet1”).Select ‘Select Sheet1
myOperator = Cells(1, 10).Value

For i = ORG_CLM To DST_CLM
‘A列の値とC列の値の和がE列に入力された答えと正しいか判定
If myOperator = “+” Then
SRT_BS = 5
If Cells(i, NUM1_RW).Value + Cells(i, NUM2_RW).Value = Cells(i, ANSW_RW).Value Then
Cells(i, ANSW_RW).Font.Color = vbBlue ‘正解なら文字色を青に
myGANS = myGANS + 1
Else
Cells(i, ANSW_RW).Font.Color = vbRed ‘不正解なら文字色を赤に
End If
End If
If myOperator = “-” Then
SRT_BS = 10
If Cells(i, NUM1_RW).Value – Cells(i, NUM2_RW).Value = Cells(i, ANSW_RW).Value Then
Cells(i, ANSW_RW).Font.Color = vbBlue ‘正解なら文字色を青に
myGANS = myGANS + 1
Else
Cells(i, ANSW_RW).Font.Color = vbRed ‘不正解なら文字色を赤に
End If
End If
If myOperator = “*” Then
SRT_BS = 15
If Cells(i, NUM1_RW).Value * Cells(i, NUM2_RW).Value = Cells(i, ANSW_RW).Value Then
Cells(i, ANSW_RW).Font.Color = vbBlue ‘正解なら文字色を青に
myGANS = myGANS + 1
Else
Cells(i, ANSW_RW).Font.Color = vbRed ‘不正解なら文字色を赤に
End If
End If
If myOperator = “/” Then
SRT_BS = 20
If Int(Cells(i, NUM1_RW).Value / Cells(i, NUM2_RW).Value) = Cells(i, ANSW_RW).Value Then
Cells(i, ANSW_RW).Font.Color = vbBlue ‘正解なら文字色を青に
myANSWR = True

Else
Cells(i, ANSW_RW).Font.Color = vbRed ‘不正解なら文字色を赤に

End If
myTemporary = Int(Cells(i, NUM1_RW).Value / Cells(i, NUM2_RW).Value)
myAmari = Cells(i, NUM1_RW).Value – myTemporary * Cells(i, NUM2_RW).Value
If Cells(i, AMAR_RW).Value = myAmari Then
Cells(i, AMAR_RW).Font.Color = vbBlue
If myANSWR = True Then
myGANS = myGANS + 1
End If
Else
Cells(i, AMAR_RW).Font.Color = vbRed
End If
End If
Next i
If myGANS = SEIKAI_SU Then
MsgBox “全問正解です。おめでとう！”
Else
MsgBox “もうちょっと！”
End If

SRT_RW = Cells(1, 13).Value ‘Bias Locate depend on 横　operator
Sheets(“Sheet2”).Select
SRT_BS = SRT_BS + SRT_RW ‘Fix Count Location
ST_PTR = Cells(1, 14).Value ‘Current 生徒の行
Cells(1, 15).Value = SRT_BS ‘横のLocation
Cells(ST_PTR, SRT_BS) = myGANS ‘正解数を入れる
Sheets(“Sheet1”).Select ‘Change Manage Page To Question Page
End Sub

Sub リセット()
Dim i As Long ‘カウンタ変数
Dim myTemporary As Long
UserForm3.Show ‘Show List2
Sheets(“Sheet2”).Select ‘Select Sheet2
If IsNumeric(Cells(1, 11).Value) Then
‘ MsgBox “True”
If Cells(1, 11).Value = 0 Then
ST_NUM = 4
Cells(1, 11).Value = ST_NUM
Else
ST_NUM = Cells(1, 11).Value ‘前回からの登録簿のスタート値を使用
‘MsgBox ST_NUM
End If
Else
ST_NUM = 4 ‘生徒ライン番号初期化
Cells(1, 11).Value = ST_NUM ‘生徒ライン番号初期化
MsgBox ST_NUM ‘for debug
End If
If MsgBox(“追加登録しますか？”, vbYesNo) = vbYes Then ‘追加登録をするか？
Do While Cells(1, 12).Value <> “End” ‘後でENDをセットするルーチンを作る事
If Cells(1, 12).Value = “End” Then ‘登録作業エンド
Sheets(“Sheet2”).Select ‘Select Sheet2
End If
Cells(1, 10).Value = “Error” ‘Error Flag On?
Do While Cells(1, 10).Value = “Error”
FRM_USER.Show ‘User Form Show Registry ID
Loop
Cells(1, 10).ClearContents ‘Error Flag On?
Loop ‘New Loop End
Else
MsgBox “今回は登録しません。”
Sheets(“Sheet2”).Select
Cells(1, 12).Value = “End”
End If
‘問題出題
Sheets(“Sheet2”).Select ‘Servey Loop End
If Cells(1, 12).Value = “End” Then
Cells(1, 12).ClearContents ‘For debug
Sheets(“Sheet1”).Select ‘Select Sheet1
UserForm1.Show ‘UserForm1 Show 加減乗除
UserForm2.Show ‘桁数セット
End If
Sheets(“Sheet1”).Select ‘Select Sheet1
myBias = Cells(1, 11).Value ‘WorkCell for Bias Value
myOperator = Cells(1, 10).Value ‘Workarea for Operator

For i = ORG_CLM To DST_CLM
Cells(i, ANSW_RW).ClearContents ‘値をクリア
Cells(i, AMAR_RW).ClearContents
Cells(i, ANSW_RW).Font.Color = vbBlack ‘文字色を黒に
Cells(i, AMAR_RW).Font.Color = vbBlack
Cells(i, NUM1_RW).Value = Int(Rnd * myBias) ‘A列に１桁～４桁のランダムな数値を入力
Cells(i, OPR_RW).Value = myOperator ‘四則演算子を入れる
Cells(i, NUM2_RW).Value = Int(Rnd * myBias) ‘Ａ列に１桁～４桁のランダムな数値を入力
If myOperator = “-” Then
myTemporary = Cells(i, NUM1_RW)
If Cells(i, NUM1_RW) < Cells(i, NUM2_RW) Then Cells(i, NUM1_RW) = Cells(i, NUM2_RW) Cells(i, NUM2_RW) = myTemporary End If End If If myOperator = "/" Then myTemporary = Cells(i, NUM1_RW) If Cells(i, NUM1_RW) < Cells(i, NUM2_RW) Then Cells(i, NUM1_RW) = Cells(i, NUM2_RW) Cells(i, NUM2_RW) = myTemporary If Cells(i, NUM2_RW) = 0 Then 'Escape 0 devide Cells(i, NUM2_RW) = 1 End If Else If Cells(i, NUM2_RW) = 0 Then 'Escape 0 devide Cells(i, NUM2_RW) = 1 End If End If End If Next i End Sub Option Explicit Dim strMSG As String Public ST_NUM As Long Private Sub TextBox2_Change() MsgBox "Box2" Unload Me End Sub Private Sub TextBox3_Change() MsgBox "Box3" Unload Me End Sub Private Sub FRM_USER() MsgBox "FRM_USER()" Unload Me End Sub Private Sub CMD_OK_Click() 'UserForm_Click() 'MsgBox "Execute _Click() on Registry" Sheets("Sheet2").Select 'Select Sheet2 If OptionButton1.Value = True Then '登録終了 Cells(1, 12).Value = "End" End If If OptionButton2.Value = True Then Cells(1, 12).ClearContents End If If OptionButton3.Value = True Then Cells(1, 13).Value = "指定" 'Fix Row End If '入力内容のチェック If Trim$(TXT_NAME.Text) = "" Then strMSG = "氏名が入力されていません。" ElseIf Trim$(TXT_CODE.Text) = "" Then strMSG = "生徒Noが入力されていません。" ElseIf Trim$(TXT_SCLNM.Text) = "" Then strMSG = "学校名が入力されていません。" ElseIf IsNumeric(Trim$(TXT_CODE.Text)) <> True Then
strMSG = “生徒Noが数字ではありません。”
ElseIf Len(Trim$(TXT_CODE.Text)) <> 5 Then
strMSG = “生徒Noは5桁で入力してください。”
ElseIf Trim$(TXT_CODE.Text) < 10000 Then strMSG = "生徒Noは10000以上で入力してください。" End If Sheets("Sheet2").Select 'Select Sheet2 If Trim$(strMSG) <> “” Then
Cells(1, 10).Value = “Error” ‘Set Error Flag
MsgBox strMSG
Else
Cells(1, 10).ClearContents ‘Clear Error Flag
ST_NUM = Cells(1, 11).Value ‘生徒の番号をセット

Cells(ST_NUM, 1).Value = Trim$(TXT_NAME.Text) ‘氏名
Cells(ST_NUM, 2).Value = Trim$(TXT_CODE.Text) ‘生徒No
Cells(ST_NUM, 3).Value = Trim$(TXT_SCLNM.Text) ‘学校名
ST_NUM = ST_NUM + 1 ‘Sheet2の行No
Cells(1, 11).Value = ST_NUM ‘Save 生徒No
End If
Unload Me
End Sub
Option Explicit

Private Sub CommandButton1_Click()
ListBox1.RowSource = “Sheet2!A4:A103” ‘Set List
‘Unload Me
End Sub
Private Sub ListBox1_Click()
‘MsgBox Cells(ListBox1.ListIndex + 1, 1) ‘Display ST_NUM 生徒No
‘MsgBox ListBox1.ListIndex ‘Line No. ST_PTR – 4
Sheets(“Sheet2”).Select
Cells(1, 14).Value = ListBox1.ListIndex + 4
‘MsgBox ListBox1.ListIndex + 4 ‘Line NO. ST_PTR
End Sub

Option Explicit
Dim strMSG As String
Public ST_NUM As Long
Private Sub TextBox2_Change()
MsgBox “Box2”
Unload Me
End Sub

Private Sub TextBox3_Change()
MsgBox “Box3”
Unload Me
End Sub

Private Sub FRM_USER()
MsgBox “FRM_USER()”
Unload Me
End Sub
Private Sub CMD_OK_Click() ‘UserForm_Click()
‘MsgBox “Execute _Click() on Registry”
Sheets(“Sheet2”).Select ‘Select Sheet2
If OptionButton1.Value = True Then ‘登録終了
Cells(1, 12).Value = “End”
End If
If OptionButton2.Value = True Then
Cells(1, 12).ClearContents
End If
If OptionButton3.Value = True Then
Cells(1, 13).Value = “指定” ‘Fix Row
End If
‘入力内容のチェック
If Trim$(TXT_NAME.Text) = “” Then
strMSG = “氏名が入力されていません。”
ElseIf Trim$(TXT_CODE.Text) = “” Then
strMSG = “生徒Noが入力されていません。”
ElseIf Trim$(TXT_SCLNM.Text) = “” Then
strMSG = “学校名が入力されていません。”
ElseIf IsNumeric(Trim$(TXT_CODE.Text)) <> True Then
strMSG = “生徒Noが数字ではありません。”
ElseIf Len(Trim$(TXT_CODE.Text)) <> 5 Then
strMSG = “生徒Noは5桁で入力してください。”
ElseIf Trim$(TXT_CODE.Text) < 10000 Then strMSG = "生徒Noは10000以上で入力してください。" End If Sheets("Sheet2").Select 'Select Sheet2 If Trim$(strMSG) <> “” Then
Cells(1, 10).Value = “Error” ‘Set Error Flag
MsgBox strMSG
Else
Cells(1, 10).ClearContents ‘Clear Error Flag
ST_NUM = Cells(1, 11).Value ‘生徒の番号をセット

Cells(ST_NUM, 1).Value = Trim$(TXT_NAME.Text) ‘氏名
Cells(ST_NUM, 2).Value = Trim$(TXT_CODE.Text) ‘生徒No
Cells(ST_NUM, 3).Value = Trim$(TXT_SCLNM.Text) ‘学校名
ST_NUM = ST_NUM + 1 ‘Sheet2の行No
Cells(1, 11).Value = ST_NUM ‘Save 生徒No
End If
Unload Me
End Sub

Option Explicit
Public myOperator As String
Const OPR_RW As Integer = 2

Private Sub CommandButton1_Click() ‘UserForm_Click()
Sheets(“Sheet1”).Select ‘Select Sheet1
If OptionButton1.Value = True Then
myOperator = “+”
End If
If OptionButton2.Value = True Then
myOperator = “-”
End If
If OptionButton3.Value = True Then
myOperator = “*”
End If
If OptionButton4.Value = True Then
myOperator = “/”
End If
‘MsgBox myOperator
Cells(1, 10).Value = myOperator ‘Save Operator as String
Unload Me
End Sub

‘Private Sub UserForm_Click()
‘ ‘UserForm.Show
‘ MsgBox “Before CommandButton1”
‘End Sub
Private Sub UserForm_Click()

End Sub

Option Explicit
Public myBias As Long
Public SRT_RW As Long
Private Sub CommandButton1_Click() ‘UserForm_Click()
Sheets(“Sheet1”).Select ‘Select Sheet1
SRT_RW = 0 ‘Initialize Operator Bias Location
‘MsgBox “Before CommandButton1”
If OptionButton1.Value = True Then ‘1桁
myBias = 10
SRT_RW = SRT_RW + 0
End If
If OptionButton2.Value = True Then ‘2桁
myBias = 100
SRT_RW = SRT_RW + 1
End If
If OptionButton3.Value = True Then ‘3桁
myBias = 1000
SRT_RW = SRT_RW + 2
End If
If OptionButton4.Value = True Then ‘4桁
myBias = 10000
SRT_RW = SRT_RW + 3
End If
‘MsgBox myBias
Cells(1, 11).Value = myBias ‘Save 桁数
Cells(1, 13).Value = SRT_RW
Unload Me
End Sub

‘Private Sub UserForm_Click()
‘ MsgBox “Here is UserForm2”
‘UserForm2.Show
‘End Sub
Private Sub UserForm_Click()

End Sub
Option Explicit

Private Sub CommandButton1_Click()
ListBox1.RowSource = “Sheet2!A4:A103” ‘Set List
‘Unload Me
End Sub
Private Sub ListBox1_Click()
‘MsgBox Cells(ListBox1.ListIndex + 1, 1) ‘Display ST_NUM 生徒No
‘MsgBox ListBox1.ListIndex ‘Line No. ST_PTR – 4
Sheets(“Sheet2”).Select
Cells(1, 14).Value = ListBox1.ListIndex + 4
‘MsgBox ListBox1.ListIndex + 4 ‘Line NO. ST_PTR
End Sub

※本プログラムをご利用の方はお問い合わせフォームより「学校計算ドリルテスト」希望の旨、メールアドレスを記入し申し込んでください。折り返し本プログラムを添付し送らさせて戴きます。「種別」は「活動に関するお問い合わせ」でお願いします。

↑人気ブログランキングに参加しています。よろしければ１票を！