Download presentation
Presentation is loading. Please wait.
1
「入力」はInputBoxやテキストボックスに限らず、 セルからのデータの入力や、チェックボックス等からの入力全てを含める。
始めに空白の九九表が表示され、出題ボタンを押すたびに九九の 問題を出題、正誤を知らせて、九九表を埋めていく
3
始めに空白の九九表が 表示され、出題ボタンを 押すたびに九九の問題 を出題、正誤を知らせて 九九表を埋めていく Cells = ""
4
九九の問題作成 出題 正誤判定 Dim i As Integer 1行目とA列に九九の段を表示する
For i = 1 To 9 '九九表作成 Cells(i + 1, 1).Value = i Cells(1, i + 1).Value = i Next Dim a As Integer, b As Integer '乱数用×2 Dim c As Integer '解答用 a = Int(Rnd() * 9 + 1) '1～9の乱数発生 b = Int(Rnd() * 9 + 1) '1～9の乱数発生 c = InputBox(a & "×" & b & "=", "出題") '出題 If c = a * b Then '正解の場合 MsgBox "答えは" & a * b & "です", , "正解" Else '間違いの場合 MsgBox "答えは" & a * b & "です", , "間違い" End If Cells(a + 1, b + 1).Value = a * b '九九表を埋める 1行目とA列に九九の段を表示する 九九の問題作成 出題 正誤判定
5
改良！ Dim i As Integer For i = 1 To 9 '九九表作成 Cells(i + 1, 1).Value = i
Next Dim a As Integer, b As Integer '乱数用×2 Dim c As Variant '解答用 Variant型なのはエラー防止 lp: '重複があったときに乱数ふり直し a = Int(Rnd() * 9 + 1) '1～9の乱数発生 b = Int(Rnd() * 9 + 1) '1～9の乱数発生 If Cells(a + 1, b + 1).Value <> "" Then GoTo lp '重複していた場合 c = InputBox(a & "×" & b & "=", "出題") '出題 If c = "" Then c = 0 '空白でEnterを押したら強制的に間違いにする If c = a * b Then '正解の場合 MsgBox "答えは" & a * b & "です", , "正解" Else '間違いの場合 MsgBox "答えは" & a * b & "です", , "間違い" End If Cells(a + 1, b + 1).Value = a * b '九九表を埋める 改良！ エラー防止の準備 InputBoxで何も入れずに Enterを押した時に エラーが出ないように するため。 出題が重複した場合の処理 九九表が出題済みのフラグも 兼ねている エラー防止 InputBoxで何も入れずに Enterを押した時の処理
6
三点から二次関数を導出する一般式を求めればほぼ完成！
7
係数a～cの算出と式の表示 Dim x(3) As Single, y(3) As Single 'プロット1～3用
Dim a As Single, b As Single, c As Single '二次関数の係数 Dim a1 As Single, a2 As Single '係数計算補助 Dim i As Integer 'For文用 For i = 1 To 3 'プロット1～3の位置を変数に格納 x(i) = Cells(i + 1, 2).Value 'B2～B4セル Xの値を取得 y(i) = Cells(i + 1, 3).Value 'C2～C4セル Yの値を取得 Next '係数算出 aは複雑なので分子a1と分母a2に分けて計算 a1 = (y(2) - y(3) - (y(1) - y(2)) * (x(2) - x(3)) / (x(1) - x(2))) a2 = (x(2) ^ 2 - x(3) ^ 2) - (x(1) + x(2)) * (x(2) - x(3)) a = a1 / a2 b = (y(1) - y(2)) / (x(1) - x(2)) - a * (x(1) + x(2)) c = y(1) - a * x(1) ^ 2 - b * x(1) Cells(8, 1).Value = "二次関数 y=" & a & "x^2 + " & b & "x + " & c
8
続き グラフの描画 Cells(9, 1).Value = "x" 'ラベルの表示 Cells(9, 2).Value = "y"
For i = 1 To 'プロットのデータを出力 x=1～10 Cells(9 + i, 1).Value = i Cells(9 + i, 2).Value = a * i ^ 2 + b * i + c Next 'グラフがすでにあったら削除 If ChartObjects.Count > 0 Then ChartObjects.Delete 'マクロの記録で作成 グラフの描画 Range("A10:B19").Select ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select ActiveChart.SetSourceData Source:=Range("Sheet6!$A$10:$B$19")
9
Dim i As Integer, v As Integer '4×4カード準備
Dim a As Integer '乱数発生用 '4×4カード準備 For i = 1 To 4 For v = 1 To 4 a = Int(Rnd() * ) Cells(i, v).Value = a Cells(i, v).Font.Color = RGB(0, 0, 0) Next Dim i As Integer, v As Integer '4×4スキャン用 Dim a As Integer '乱数発生用 Dim b As Integer 'ビンゴチェック用 '番号発表 a = Int(Rnd() * ) MsgBox "番号は" & a & "です" '番号にマークをつける For i = 1 To 4 For v = 1 To 4 b = Cells(i, v).Value If b = a Then Cells(i, v).Font.Color = RGB(255, 0, 0) End If Next
10
変則ビンゴ改良版 重複番号なし、ビンゴ判定つき
Dim i As Integer, v As Integer '4×4カード準備 Dim a As Integer '乱数発生用 Cells = "" '4×4カード準備 For i = 1 To 4 For v = 1 To 4 looptop: '重複があったら乱数を振り直す a = Int(Rnd() * ) 'F(番号+1)セルが空白でないなら既に出ている。 If Cells(a + 1, 6).Value <> "" Then GoTo looptop Cells(a + 1, 6).Value = a '使用済みフラグをたてる Cells(i, v).Value = a Cells(i, v).Font.Color = RGB(0, 0, 0) Next '最後にフラグをクリア For i = 1 To 16 Cells(i + 1, 6).Value = "" 番号履歴と言いつつ、 実は数字の利用済みフラグ
11
次ページに続きます。 変則ビンゴ改良版 重複番号なし、ビンゴ判定つき 番号履歴と言いつつ、 実は数字の利用済みフラグ
Dim i As Integer, v As Integer '4×4スキャン用 Dim a As Integer '乱数発生用 Dim b As Integer 'ビンゴチェック用 Cells(1, 6).Value = "番号履歴" '番号発表 looptop: '「カード準備」と全く同じ a = Int(Rnd() * ) 'セルが空白でないなら既に出ている。 If Cells(a + 1, 6).Value <> "" Then GoTo looptop Cells(a + 1, 6).Value = a '使用済みフラグをたてる MsgBox "番号は" & a & "です" '番号にマークをつける For i = 1 To 4 For v = 1 To 4 b = Cells(i, v).Value If b = a Then Cells(i, v).Font.Color = RGB(255, 0, 0) End If Next 番号履歴と言いつつ、 実は数字の利用済みフラグ 次ページに続きます。
12
続き 文字の色をフラグとして使い、 縦、横、斜めで色が変わっている 数字をカウント 色が変わっている数字の数が 4ならビンゴ
'ビンゴのチェック Dim x(4) As Integer, y(4) As Integer '縦横ビンゴチェック用 Dim c(4) As Integer '右斜め、左斜めビンゴチェック用 c(3),c(4)はダミー 'フラグのクリア For i = 1 To 4 x(i) = 0 y(i) = 0 c(i) = 0 Next 'ビンゴのチェック For文をネストさせるともっとシンプルになる For v = 1 To 4 '横方向1～4行目の色が変わっている数字をカウント If Cells(1, v).Font.Color = RGB(255, 0, 0) Then x(1) = x(1) + 1 If Cells(2, v).Font.Color = RGB(255, 0, 0) Then x(2) = x(2) + 1 If Cells(3, v).Font.Color = RGB(255, 0, 0) Then x(3) = x(3) + 1 If Cells(4, v).Font.Color = RGB(255, 0, 0) Then x(4) = x(4) + 1 '縦方向1～4列目の色が変わっている数字をカウント If Cells(v, 1).Font.Color = RGB(255, 0, 0) Then y(1) = y(1) + 1 If Cells(v, 2).Font.Color = RGB(255, 0, 0) Then y(2) = y(2) + 1 If Cells(v, 3).Font.Color = RGB(255, 0, 0) Then y(3) = y(3) + 1 If Cells(v, 4).Font.Color = RGB(255, 0, 0) Then y(4) = y(4) + 1 '右斜めA1～D4の色が変わっている数字をカウント If Cells(v, v).Font.Color = RGB(255, 0, 0) Then c(1) = c(1) + 1 '左斜めA4～D1の色が変わっている数字をカウント If Cells(v, 5 - v).Font.Color = RGB(255, 0, 0) Then c(2) = c(2) + 1 'ビンゴのチェック c(3)、c(4)はダミー If x(i) = 4 Then MsgBox i & "行目横方向ビンゴ" If y(i) = 4 Then MsgBox i & "列目縦方向ビンゴ" If c(i) = 4 Then MsgBox "斜め方向ビンゴ" 文字の色をフラグとして使い、 縦、横、斜めで色が変わっている 数字をカウント 色が変わっている数字の数が 4ならビンゴ
Similar presentations
