単語テスト用シートの作成

要約

ExcelでVBAを用いて単語テスト用シートを作成しました。

背景

知り合いに「英単語テスト用のExcelシートを作ってほしい」と頼まれました。

要件

• シートは単語帳、和訳テスト用、英訳テスト用の３種類。
• 単語帳に英単語とその日本語約を記録していく。
• 和訳テストまたは英訳テストのシートには、単語帳に記録された英単語―日本語ペアから重複なく無作為に、指定した数だけ抽出され表示される。
• 上記の抽出はボタン一つで行われる。
• 答え合わせもボタン一つで行えるようにする。

できたもの

1. 単語帳シートのA列に英単語を、B列に日本語訳を記録していきます。"学習済み"（C列）は今は特に参照されていません。
2. 英訳テストシートでは、単語をセットボタンをクリックすると、単語帳シートに記録された英単語から無作為にG1のセルで指定した数だけ抽出され、A列に表示されます。
3. B列に自分の解答を入力します。
4. 答え合わせボタンをクリックすると、D列に答えが表示され、C列に正誤（〇×）が表示されます。
5. G7のセルには正解数が、G8のセルには正解数の％表示が表示されます。

和訳テストシートでも同様の操作になります。
エクセルシートはgithubで公開してます。

コード

和訳の方だけ載せます。英訳の方は参照する列番号を変えるだけです。

Sub 和訳テスト_単語をセット()
'重複なく値を取り出す部分の参考：http://sato001.com/excel-vba-random25

Dim nbrOfWords As Integer '単語の数
Dim ws As Worksheet '"単語帳"シート用のオブジェクト
Set ws = Worksheets("単語帳")
ws.Activate
Range("A1").CurrentRegion.Select
nbrOfWords = Selection.Rows.Count - 1 '単語数の取り出し。空白があるとそれより前で止まる。

Dim ws2 As Worksheet '"和訳テスト"シート用のオブジェクト
Set ws2 = Worksheets("和訳テスト")

Dim nbrOfTargets As Integer 'テスト単語数用変数
ws2.Activate
If IsNumeric(Range("G1").Value) = False Then
    MsgBox "テスト単語数が不正です"
    Exit Sub
ElseIf Range("G1").Value = 0 Then
    MsgBox "テスト単語数は１以上でなければなりません"
    Exit Sub
ElseIf Range("G1").Value > nbrOfWords Then
    MsgBox "テスト単語数は単語帳の単語数より少なくなければなりません"
    Exit Sub
Else
    nbrOfTargets = Range("G1").Value
End If

Dim target As Integer '乱数で選択するカラム用変数
Dim a As Integer 'カウント用整数
Dim flag() As Boolean '重複チェック用フラグ配列
ReDim flag(nbrOfWords)

'単語の抽出
Randomize
For a = 1 To nbrOfTargets
    Do
        target = Int(Rnd * nbrOfWords) + 1
    Loop While flag(target)
    flag(target) = True
    
    ws2.Cells(a + 1, 1).Value = ws.Cells(target + 1, 1).Value
    ws2.Cells(a + 1, 2).ClearContents
    ws2.Cells(a + 1, 3).ClearContents
    ws2.Cells(a + 1, 4).ClearContents
Next

For a = nbrOfTargets + 1 To nbrOfWords
    ws2.Cells(a + 1, 1).ClearContents
    ws2.Cells(a + 1, 2).ClearContents
    ws2.Cells(a + 1, 3).ClearContents
    ws2.Cells(a + 1, 4).ClearContents
Next

'セルの罫線
'参考：http://officetanaka.net/excel/vba/cell/cell07.htm
ws2.Range(ws2.Cells(nbrOfTargets + 2, 1), ws2.Cells(nbrOfWords + 1, 4)).Borders.LineStyle = False
ws2.Range(ws2.Cells(2, 1), ws2.Cells(nbrOfTargets + 1, 4)).Borders.LineStyle = True

End Sub

Sub 和訳テスト_採点()
'Match関数利用の部分の参考：https://qiita.com/furano_kumarin/items/bd34799eb1ec0fb84cbe

Dim nbrOfWords As Integer 'テスト単語の数

Dim ws As Worksheet '"単語帳"シート用のオブジェクト
Dim ws2 As Worksheet '"和訳テスト"シート用のオブジェクト
Set ws = Worksheets("単語帳")
Set ws2 = Worksheets("和訳テスト")

ws.Activate
Range("A1").CurrentRegion.Select
nbrOfWords = Selection.Rows.Count - 1

Dim nbrOfTargets As Integer 'テスト単語数用変数
ws2.Activate
Range("A1").CurrentRegion.Select
nbrOfTargets = Selection.Rows.Count - 1

If nbrOfTargets > nbrOfWords Then
    MsgBox "テストが不正です。"
    Exit Sub
End If

Dim enWordList As Range '英単語リスト
Set enWordList = ws.Range(ws.Cells(2, 1), ws.Cells(nbrOfWords + 2, 1))

Dim a As Integer 'カウント用整数
Dim jaStr As String '取り出した英単語格納用
For a = 1 To nbrOfTargets
    '単語の取り出し
    enStr = ws2.Cells(a + 1, 1).Value
    On Error Resume Next
    ws2.Cells(a + 1, 4).Value = ws.Cells(Application.WorksheetFunction.Match(enStr, enWordList, 0) + 1, 2)
    If Err <> 0 Then
        ws2.Cells(a + 1, 4).Value = "ERROR"
        Err.Clear
    End If
    
    '正誤チェック
    If ws2.Cells(a + 1, 2).Value = ws2.Cells(a + 1, 4).Value Then
        ws2.Cells(a + 1, 3).Value = "〇"
    Else
        ws2.Cells(a + 1, 3).Value = "×"
    End If
Next

End Sub

感想

久々にVBAに触れました。
単語テスト用シートに関しては、探してはいませんがほかにいくらでも公開されていると思います。

参考

• エクセルVBAで1～25までの数字をランダムに発生させる処理を考えてみました：重複なく無作為に取り出す方法
• Office TANAKA - Excel VBA講座：セルの操作[罫線の設定]：セルに罫線を引く方法
• Excel VBAでVLookup風な処理を高速かつ柔軟に動作させる方法 - Qiita：Match関数を利用して答えを出す方法