【Excelマクロ】漢検読み問題演習アプリ

Excelマクロ

　先日、漢検準1級を受検し無事合格した。

【漢検準1級】合格までの勉強法&本番にやったこと
つい嬉しくて呟いてしまった。 　いや、まさか受かってるとは思ってなかったもんだから... これまでの振り返り こちらは本筋から外れたトピックなので、はよ勉強法教えろという人は次章からお読みください。 　前から受けたいと思っていた漢検を始めて...
pictblog.com
2022.07.28

　漢検準1級を勉強するにあたり、読み問題の対策にはExcelマクロを利用した。

　具体的には、Excelマクロのインプットボックスを利用し、一問一答形式の問題演習アプリを作成した。

　体裁は必要最低限の仕上がりだが、実用面では大いに役立った。

　本記事では本アプリの使い方、マクロの詳細について解説していく。

Microsoft Excel 2019の利用を想定しています。

広告

サンプル

　今回使うサンプルは下記ボタンから入手可能である。

漢検準1級問題演習_サンプル.zip ↓

　

　マクロ本体「漢検準1級問題演習_サンプル.xlsm」を開くと、下のようなウィンドウが表示される。

図1

　漢検準1級の読み問題のジャンルごとに演習が可能であり、それぞれ下記の3つのモードを用意している。

  • 全問：マクロに保存されている全ての問題を出題する。
  • 10問ランダム：マクロに保存されている問題の中から10問をランダムに選んで出題する。
  • 苦手問題：誤答した実績がある問題のみを抽出して出題する。

　

　ボタンをクリックすると、図2のようなインプットボックスが表示される。

　これに回答すると、図3のようにメッセージボックスで正誤が「〇」または「×」で表示され、正答がその下に表示される。

　図3の「OK」ボタンを押すと、次の問題へ進む。

　全ての問題を解き終えると、図4のようにメッセージボックスで正答率を表示する。

図2
図3
図4

　

　Sheet2はマクロ駆動の為に意図的に白紙にしている。

　

　Sheet3以降は各ジャンルの問題を格納している。

　問題番号(Num)、問題、正答、初期スコア(－1000)を設定すれば、自前で問題を作成することが可能である。

本マクロはサンプルであり、内蔵されている問題数は各ジャンルで20問ずつに限定しています。

コード詳説

　「漢検準1級問題演習_サンプル.xlsm」には12のマクロが保存されている。

　しかし基本は3つのマクロの使い回しであるため、代表して「音読み」用の3つのマクロを掲載することにする。

　また、本記事では網羅的な解説はせず、マクロの流れの要となる部分に焦点を絞ることにする。　

音読み全問

　音読み問題全問を出題する「音読み全問」マクロの中身は下記のようになっている。

Sub 音読み全問()

Dim R As Variant
Dim ans As String
Dim OK As Long
Dim mondaisu As Long
Dim kijun As Long
Dim zenmon As Long
Dim sheet As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Worksheets(2).Cells.Clear

kijun = 1
zenmon = 1
sheet = 3

Do While Worksheets(sheet).Cells(zenmon + kijun, 1).Value <> 0
    zenmon = zenmon + 1
Loop

zenmon = zenmon - 1

For i = 1 To zenmon
    Worksheets(2).Cells(i, 1).Value = Worksheets(sheet).Cells(i + kijun, 2).Value
    Worksheets(2).Cells(i, 2).Value = Worksheets(sheet).Cells(i + kijun, 3).Value
    R = Rnd
    Worksheets(2).Cells(i, 3).Value = R
Next


Worksheets(2).Range("A1").CurrentRegion.Sort _
Key1:=Worksheets(2).Range("C1"), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlNo

OK = 0


mondaisu = zenmon

For j = 1 To mondaisu

    ans = InputBox(Worksheets(2).Cells(j, 1).Value, "問" & j & "/問" & mondaisu, "")

    If ans = Worksheets(2).Cells(j, 2).Value Then
        MsgBox "○" & vbLf & vbLf & Worksheets(2).Cells(j, 1).Value & "(" & Worksheets(2).Cells(j, 2).Value & ")"
        OK = OK + 1
        
        For m = 1 To zenmon
            If Worksheets(sheet).Cells(1 + m, 2).Value = Worksheets(2).Cells(j, 1).Value And Worksheets(sheet).Cells(1 + m, 4).Value > -1000 Then
                Worksheets(sheet).Cells(1 + m, 4).Value = Worksheets(sheet).Cells(1 + m, 4).Value - 1
            End If
        Next
        
    ElseIf StrPtr(ans) = 0 Then
        Exit Sub
    Else
        MsgBox "×" & vbLf & vbLf & Worksheets(2).Cells(j, 1).Value & "(" & Worksheets(2).Cells(j, 2).Value & ")"
        
        For k = 1 To zenmon
            If Worksheets(sheet).Cells(1 + k, 2).Value = Worksheets(2).Cells(j, 1).Value Then
                Worksheets(sheet).Cells(1 + k, 4).Value = Worksheets(sheet).Cells(1 + k, 4).Value + 5
            End If
        Next
        
    End If

Next


A = 100 * OK / mondaisu
MsgBox "正答率：" & A & "%"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

　

　まずは

Do While Worksheets(sheet).Cells(zenmon + kijun, 1).Value <> 0
    zenmon = zenmon + 1
Loop

zenmon = zenmon - 1

で全問の問題数をカウントする。

　

　次に

For i = 1 To zenmon
    Worksheets(2).Cells(i, 1).Value = Worksheets(sheet).Cells(i + kijun, 2).Value
    Worksheets(2).Cells(i, 2).Value = Worksheets(sheet).Cells(i + kijun, 3).Value
    R = Rnd
    Worksheets(2).Cells(i, 3).Value = R
Next

で、Sheet3にある音読み問題の全問をSheet2にコピペし、それぞれの問題に乱数を振る。

　

　次に

Worksheets(2).Range("A1").CurrentRegion.Sort _
Key1:=Worksheets(2).Range("C1"), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlNo

でSheet2にコピペした問題を、乱数の昇順でソートする。

　こうすることで、マクロを起動させる毎にランダムな順番で問題を出題することが可能となる。

　

　

　ここからインプットボックスとメッセージボックスの表示操作に移る。

For j = 1 To mondaisu

    ans = InputBox(Worksheets(2).Cells(j, 1).Value, "問" & j & "/問" & mondaisu, "")

でインプットボックスを表示する。

　

If ans = Worksheets(2).Cells(j, 2).Value Then
        MsgBox "○" & vbLf & vbLf & Worksheets(2).Cells(j, 1).Value & "(" & Worksheets(2).Cells(j, 2).Value & ")"
        OK = OK + 1

で、正解時のメッセージボックスの表示を設定。
　(メッセージボックスに〇と正答を表示し、正答数をカウント。)

　

For m = 1 To zenmon
            If Worksheets(sheet).Cells(1 + m, 2).Value = Worksheets(2).Cells(j, 1).Value And Worksheets(sheet).Cells(1 + m, 4).Value > -1000 Then
                Worksheets(sheet).Cells(1 + m, 4).Value = Worksheets(sheet).Cells(1 + m, 4).Value - 1
            End If
        Next

で、正答時に問題のスコアが－1000を超えていたら、スコアを1減らす。
　(誤答すると逆にスコアが増えるようになっており、スコアが－1000にまで減ると苦手問題から除外される。)

　

    ElseIf StrPtr(ans) = 0 Then
        Exit Sub

で、インプットボックスの×ボタンを押すと演習が終了するようにする。

　

 Else
        MsgBox "×" & vbLf & vbLf & Worksheets(2).Cells(j, 1).Value & "(" & Worksheets(2).Cells(j, 2).Value & ")"

で、誤答時のメッセージボックスの表示を設定。
　(メッセージボックスに×と正答を表示。)

　

 For k = 1 To zenmon
            If Worksheets(sheet).Cells(1 + k, 2).Value = Worksheets(2).Cells(j, 1).Value Then
                Worksheets(sheet).Cells(1 + k, 4).Value = Worksheets(sheet).Cells(1 + k, 4).Value + 5
            End If
        Next

で、誤答時にスコアを5増やす。
　(誤答時にスコアを5増やすことで、最低5回連続で正解しないとスコアが－1000に戻らないようにし、確実に苦手問題の回数をこなせるようにしている。)

　

　最後に

 A = 100 * OK / mondaisu
MsgBox "正答率：" & A & "%"

で正答率のメッセージボックスを表示する。

音読み10問ランダム

　10問をランダムに出題するマクロは、全問出題のマクロとほぼ同じである。

　出題数を決定する

mondaisu = zenmon

が

mondaisu = 10

になっただけである。

音読み苦手問題

　音読み問題のうち苦手と判定された問題を出題する「音読み苦手問題」マクロの中身は下記のようになっている。

Sub 音読み苦手問題()

Dim A As Variant
Dim ans As String
Dim OK As Long
Dim mondaisu As Long
Dim kijun As Long
Dim gotosu As Long
Dim zenmon As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Worksheets(2).Cells.Clear

kijun = 1
gotosu = 1
sheet = 3
zenmon = 1

Do While Worksheets(sheet).Cells(zenmon + kijun, 1).Value <> 0
    zenmon = zenmon + 1
Loop

zenmon = zenmon - 1

Worksheets(sheet).Range("A1").CurrentRegion.Sort _
Key1:=Worksheets(sheet).Range("D1"), Order1:=xlDescending, _
Orientation:=xlTopToBottom, Header:=xlYes

If Worksheets(sheet).Cells(gotosu + kijun, 4) <= -1000 Then
    MsgBox "苦手問題はありません。"
    Exit Sub
End If

Do While Worksheets(sheet).Cells(gotosu + kijun, 4) > -1000
    Worksheets(2).Cells(gotosu, 1).Value = Worksheets(sheet).Cells(gotosu + kijun, 2).Value
    Worksheets(2).Cells(gotosu, 2).Value = Worksheets(sheet).Cells(gotosu + kijun, 3).Value
    Worksheets(2).Cells(gotosu, 3).Value = Worksheets(sheet).Cells(gotosu + kijun, 4).Value
    gotosu = gotosu + 1
Loop

Worksheets(sheet).Range("A1").CurrentRegion.Sort _
Key1:=Worksheets(sheet).Range("A1"), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes

OK = 0

gotosu = gotosu - 1
mondaisu = gotosu

For j = 1 To mondaisu

    ans = InputBox(Worksheets(2).Cells(j, 1).Value, "問" & j & "/問" & mondaisu, "")

    If ans = Worksheets(2).Cells(j, 2).Value Then
        MsgBox "○" & vbLf & vbLf & Worksheets(2).Cells(j, 1).Value & "(" & Worksheets(2).Cells(j, 2).Value & ")"
        OK = OK + 1
        
        For m = 1 To zenmon
            If Worksheets(sheet).Cells(1 + m, 2).Value = Worksheets(2).Cells(j, 1).Value And Worksheets(sheet).Cells(1 + m, 4).Value > -1000 Then
                Worksheets(sheet).Cells(1 + m, 4).Value = Worksheets(sheet).Cells(1 + m, 4).Value - 1
            End If
        Next
        
    ElseIf StrPtr(ans) = 0 Then
        Exit Sub
    Else
        MsgBox "×" & vbLf & vbLf & Worksheets(2).Cells(j, 1).Value & "(" & Worksheets(2).Cells(j, 2).Value & ")"
        
        For k = 1 To zenmon
            If Worksheets(sheet).Cells(1 + k, 2).Value = Worksheets(2).Cells(j, 1).Value Then
                Worksheets(sheet).Cells(1 + k, 4).Value = Worksheets(sheet).Cells(1 + k, 4).Value + 5
            End If
        Next
        
    End If

Next


A = 100 * OK / mondaisu
MsgBox "正答率：" & A & "%"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

　ベースとなるマクロは全問出題マクロと同じだが、本マクロでは途中で苦手問題を抽出するプロセスが入る。

　

　

　まずは

Worksheets(sheet).Range("A1").CurrentRegion.Sort _
Key1:=Worksheets(sheet).Range("D1"), Order1:=xlDescending, _
Orientation:=xlTopToBottom, Header:=xlYes

で、問題のスコアで降順にソートする。

　

　次に

If Worksheets(sheet).Cells(gotosu + kijun, 4) <= -1000 Then
    MsgBox "苦手問題はありません。"
    Exit Sub
End If

で、もし苦手問題が無い(全ての問題のスコアが－1000である場合)に、「苦手問題はありません。」と表示するメッセージボックスを設定する。

　

　次に

Do While Worksheets(sheet).Cells(gotosu + kijun, 4) > -1000
    Worksheets(2).Cells(gotosu, 1).Value = Worksheets(sheet).Cells(gotosu + kijun, 2).Value
    Worksheets(2).Cells(gotosu, 2).Value = Worksheets(sheet).Cells(gotosu + kijun, 3).Value
    Worksheets(2).Cells(gotosu, 3).Value = Worksheets(sheet).Cells(gotosu + kijun, 4).Value
    gotosu = gotosu + 1
Loop

で、苦手問題(スコアが－1000を超えている問題)のみをSheet2にコピペし、苦手問題の数をカウントする。

　

　次に

Worksheets(sheet).Range("A1").CurrentRegion.Sort _
Key1:=Worksheets(sheet).Range("A1"), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes

で、一度スコアで降順にソートした問題を、問題番号順に戻す。

　

　以降はインプットボックスの設定であり、全問出題マクロと同じなので省略する。

広告

終わりに

　自分はスマホよりもパソコンの方が圧倒的に使用時間が長いので、Excelマクロのアプリはかなり役に立った。

　できればスマホでも動作するアプリも作りたいが、当分はインプットに時間を費やすことになるだろう。

　ただ今後はほぼ自分の時間は取れない。

　取れないなりにブログの更新は定期的に続けたいが、どうなるか…

　

　END

広告

コメント

タイトルとURLをコピーしました