漢字・英単語　暗記ツール

出来ないところを繰返すプログラム

　漢字や英単語など暗記ものには単語帳などがよく使われます。

　単語帳は先替えが出来ますので、覚えたものは外し、出来ないところを集中的に覚えるようにすると効率が良いと言えます。
　今回はExcelVBAで正解したものはリストから外し、不正解の問題は何度も繰り返し出題されるようなプログラムを書いてみます。

　筆者自身、簡単にできると思っていたのですが、
　意外に面倒なロジック（仕組み）でしたので、プログラミング思考の鍛錬になると思います。
　
　初心者の方にはハードルが高いかもしれませんが、少々慣れてきましたら是非挑戦してみてください。

プログラム仕様

　今回のプログラムは以下のような感じになります。

　A列に問題。B列に答えを用意しておきます。
　C列は判定用に使います。
　またD1セルには現在の問題の位置（行）が入ります。
　
　実際に使うときは、A列～D列を隠して使います。
　隠したい列を選択して、右クリックから「非表示」で隠す事ができます。
　（再度表示させたい時は「再表示」で表示できます。）

　実際に問題を解くときは以下のような画面で行います。

　このような仕様にしたのは、1シートで完結させたかったためです。
　またD1セルは、グローバル変数にしても良いのですが、複数のシートでそれぞれ別の問題を扱い時には不便です。
　あるセルをグローバル変数のように使う事で、１シートで完結させることができ、
　他のシートにも影響を与えず、プログラムも複数書く必要が無いので、このような仕様としました。

使い方

　問題と解答を用意したら、A列とB列にそれぞれ配置します。
　次に「ランダムにセット」ボタンを押すと、A列B列の順番がランダムに入れ替わります。

　「出題スタート」ボタンで問題が出題されますので、手元のノートなどに答えを書きます。
　「解答表示」ボタンで解答がでます。答え合わせをして「正解」「不正解」ボタンで結果を入力しましょう。
　
　一通り問題を出題した後は二巡目に入りますが、正解した問題は出題されなくなります。
　「不正解」の問題が二巡目、三巡目と出題され、最終的に全てに正解するまで繰り返されます。
　全て正解するとメッセージが表示されます。
　
　一回終わったら、「ランダムにセット」ボタンで問題をランダムに並べ替えてもう一度挑戦してみましょう。
　
　この方法ですと、苦手な問題は他より多く出題されますので弱点克服に効果があると思います。

　　※A列～D列は非表示にして使います。

プログラム解説

　このツールは、５個のプロシージャから出来ています。
　今回はわかりやすいようにプロシージャ名を日本語にしてみました。
　それぞれのプロシージャの内容を簡単に説明します。
　・ランダムセット()
　　最初に問題と解答をランダムに並べ替えます。
　　その他に表示用のセルやカウント用の値を初期化します。
　・出題（）
　　カウント値を繰り上げて新しい問題を出題します。
　　この時、既に正解している問題は飛ばします。
　・解答表示()
　　解答を表示します。
　・正解()、不正解()
　　正解が不正解かを記録します。
　　その後は次の問題を表示させます。

　メインとなるのは、ランダムセット()と出題()になります。
　個別に解説します。

ランダムセット（）

Sub ランダムセット()
    Dim arr
    Dim i As Long
    Dim lastRow As Long
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    arr = Range("A2:B" & lastRow)   '①　問題と答えを一旦配列に入れる
    Range("C2:C" & lastRow) = "" '前の判定をクリア
        
    Dim r As Long
    Dim temp1, temp2
    
    '②　配列をシャッフル
    Randomize
    For i = 1 To UBound(arr, 1)  '③
        r = Int((UBound(arr, 1) - 1 + 1) * Rnd + 1)
        temp1 = arr(i, 1)
        arr(i, 1) = arr(r, 1)
        arr(r, 1) = temp1
        temp2 = arr(i, 2)
        arr(i, 2) = arr(r, 2)
        arr(r, 2) = temp2
    Next
    
    '④　並べ替えた値をセルに代入
    For i = 1 To UBound(arr, 1)
        Cells(i + 1, "A") = arr(i, 1)
        Cells(i + 1, "B") = arr(i, 2)
    Next i
    
    Range("D1") = 1  '⑤　初期値を入力
    Range("F3") = ""
    Range("F5") = ""
End Sub

　このプロシージャでは、問題と解答のA列B列をランダムに並べ替えています。①②
　以前、「配列要素をランダムに入れ替える」というページで一次配列の並べ替えを解説していますので、詳細はこちらを参考にしてください。

　今回は、それを二次配列に改造しています。といってもそれほど難しくはありません。

　③注意してほしいのは、UBound(arr, 1) という風に「1番目の要素の数」を指定する事です。
　後は、要素の入れ替えを2回行うだけです。

　④並べ替えた要素は、元のセルに値を代入します。
　⑤でグローバル変数代わりに使うセルに初期値を代入し、問題と解答のセルをクリアしています。
　問題は2行目から始まりますが、出題()内で値が繰り上げるので初期値は1となっています。

出題（）

　ここではカウント用の値（D1セル）を繰り上げながら出題する問題の行を特定して、問題を表示させます。　厄介なのは、既に正解の問題は避けるという点です。

Sub 出題()
    Dim pos As Long, cnt As Long
    Dim i As Long
    Dim lastRow As Long
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row   '①
    
    pos = Range("D1")   '②
    
    cnt = 1   '③
    Do While cnt < lastRow    '④
  
        '⑤
        pos = pos + 1
        If pos > lastRow Then pos = 2
        Range("D1") = pos
     
        '⑥
        If Cells(pos, "C") <> "○" Then
            Range("F3") = Cells(pos, "A")
            Range("F5") = ""
            Exit Do
        End If
        
        cnt = cnt + 1   '⑦
    Loop
    
    If cnt = lastRow Then      '⑧
        MsgBox "全て正解したので終了します。"
        Range("D1") = 1  '初期値を入力
        Range("F3") = ""
        Range("F5") = ""
    End If
End Sub

　まず①でA列の最終行を得て問題のループが回るようにします。
　次に、②で現在の問題の位置を得ます。正確にはこの時点では1つ前の位置になります。
　
　続いて Do While ループ用にカウンタ変数を初期化します。
　今回のループは Do While文でループさせています。
　④でループの最大数は、lastRow としています。本来なら lastRow-1 で良いのですが少し多めでも特に問題ないのでこうしています。
　ループの最大値を問題数としたのは、全てが正解になっている事を想定しているからです。
　ループの内部では⑤で最初に現在の問題の位置を設定しています。
　基本的にはインクリメント（１つ増加させる）して最大値を超えたら最小値にする処理です。
　
　⑥では、正解の問題を避けて、不正解の問題を表示するようにしています。
　正解の問題が続く場合は、ここをスルーして⑦でカウントを繰り上げてループします。
　
　さて、ここで、⑤の処理と⑥の処理の順番が重要です。
　もし、⑤の処理を⑥の後に書こうとすれば、⑥のIf文の内部に⑤の処理を書く事になります。
　これでは同じ処理を二重に書く事になってしまいます。

　最後にループを抜けた時の処理です。
　⑧では、カウント用変数が、最大値を同じだった時。つまり全て正解だった時を想定して終了のメッセージを出しています。

解答表示()

Sub 解答表示()
    Dim pos As Long
    pos = Range("D1")
    
    If pos < 2 Then Exit Sub
    
    Range("F5") = Cells(pos, "B")
End Sub

　解答の表示は、現在の位置を得てB列の値を表示させています。

正解()・不正解()

Sub 正解()
    Dim pos As Long
    pos = Range("D1")
    Cells(pos, "C") = "○"
  
    Call 出題
End Sub

Sub 不正解()
    Dim pos As Long
    pos = Range("D1")
    Cells(pos, "C") = "×"

    Call 出題
End Sub

　正解、不正解ボタンを押した時の処理は、現在の問題位置に○×を記述するだけです。
　尚、その後は出題（）を実行して次の問題を表示させるようにしています。

最後に

　今回のプログラムでは、出題()のロジック（仕組み）がキモとなります。
　Do While文を使いましたが、問題の位置と関係なく問題数の分だけループさせるようにしなければ思ったような結果は得られないでしょう。
　尚、今回は１シートで完結させるために、問題と解答を同じシートに置き、カウント変数もセルから参照するようにしました。
　問題と解答を別シートにして隠したり、カウントをグローバル変数にするなど、方法はいくつかありますので環境に合わせて変更してみてください。

　最後に全ソースコードを示します。
　標準モジュールに貼り付けてプロシージャをボタンに割り当てれば動作するはずです。
　ボタンの割り当てはコメントを参照してください。
　問題はA列、解答はB列でそれぞれ２行目から入力してください。

全ソースコード

'「ランダムにセット」ボタンに割り当てる
Sub ランダムセット()
    Dim arr
    Dim i As Long
    Dim lastRow As Long
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    arr = Range("A2:B" & lastRow)   '問題と答えを一旦配列に入れる
    Range("C2:C" & lastRow) = "" '前の判定をクリア
        
    Dim r As Long
    Dim temp1, temp2
    
    '配列をシャッフル
    Randomize
    For i = 1 To UBound(arr, 1)
        r = Int((UBound(arr, 1) - 1 + 1) * Rnd + 1)
        temp1 = arr(i, 1)
        arr(i, 1) = arr(r, 1)
        arr(r, 1) = temp1
        temp2 = arr(i, 2)
        arr(i, 2) = arr(r, 2)
        arr(r, 2) = temp2
    Next
    
    '並べ替えた値をセルに代入
    For i = 1 To UBound(arr, 1)
        Cells(i + 1, "A") = arr(i, 1)
        Cells(i + 1, "B") = arr(i, 2)
    Next i
    
    Range("D1") = 1  '初期値を入力
    Range("F3") = ""
    Range("F5") = ""

End Sub

'「出題」ボタンに割り当てる
Sub 出題()
    Dim pos As Long, cnt As Long
    Dim i As Long
    Dim lastRow As Long
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    pos = Range("D1")
    
    cnt = 1
    Do While cnt < lastRow
        
        pos = pos + 1
        If pos > lastRow Then pos = 2
        Range("D1") = pos
        
        If Cells(pos, "C") <> "○" Then
            Range("F3") = Cells(pos, "A")
            Range("F5") = ""
            Exit Do
        End If
        
        cnt = cnt + 1
    Loop
    
    If cnt = lastRow Then
        MsgBox "全て正解したので終了します。"
        Range("D1") = 1  '初期値を入力
        Range("F3") = ""
        Range("F5") = ""
    End If
End Sub

'「解答表示」ボタンに割り当てる
Sub 解答表示()
    Dim pos As Long
    pos = Range("D1")
    
    If pos < 2 Then Exit Sub
    
    Range("F5") = Cells(pos, "B")
End Sub

'「正解」ボタンに割り当てる
Sub 正解()
    Dim pos As Long
    pos = Range("D1")
    
    Cells(pos, "C") = "○"
    
    Call 出題
End Sub

'「不正解」ボタンに割り当てる
Sub 不正解()
    Dim pos As Long
    pos = Range("D1")
    
    Cells(pos, "C") = "×"

    Call 出題
End Sub