0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

VBAでExcelを単語帳にする

Last updated at Posted at 2023-08-26

イメージ画像

スクリーンショット 2023-08-26 193609.png

初期設定

1.新しいブックを用意します。
2.下のVBAのソースコードをVBエディタにコピーします。
3.新しいシートにA1セルに「問題を解く」ボタンを用意し、VBAのプログラムを割り当てます。
4.A2に「単語・用語」、B2に「意味」、C2に「正解数」、D2に「不正解数」を入力します。

これで初期設定は完了です。

問題の作り方

「単語・用語」の下に出題したい単語・用語を記入し、
「意味」のところにその意味を記入するだけです!

使い方

1.上の「問題を解く」ボタンを押します。

上のイメージ図を参照してください。

2.問題が表示されるので、回答を書きます。無回答もしくは「キャンセル」で出題が止まります。

スクリーンショット 2023-08-26 193715.png

3.OKを押すと、答えが表示されます。正解なら

「はい」、不正解なら「いいえ」を押しましょう。
スクリーンショット 2023-08-26 193730.png

4.正解と不正解の数が記録されます。

スクリーンショット 2023-08-26 193806.png

ソースコード

Option Explicit

Sub TestWords()
    Debug.Print Format(Now, "hh:mm:ss") & " 処理を開始します!"
    
    Dim wordsRange As Range
    Dim beforeFirstRowNum As Integer
    Dim lastRowNum As Integer
    
    Dim wordsCount As Integer
    Dim randomRowNum As Integer
    Dim tmp As Integer
    
    Dim wordValue As String
    
    Dim wordRowNum As Integer
    
    beforeFirstRowNum = 2
    
    lastRowNum = ActiveSheet.Cells(10000, 1).End(xlUp).Row
    
    Set wordsRange = ActiveSheet.Range(ActiveSheet.Cells(3, 1), ActiveSheet.Cells(lastRowNum, 1))
    
    wordsCount = lastRowNum - beforeFirstRowNum
        
    If wordsCount = 0 Then
        MsgBox "Wordsが登録されていません。処理を終了します。"
        End
    End If
    
    
    'VBAの配列は0から始まる
    Dim i As Integer
    Dim arrListedRandomNum As Variant
    ReDim arrListedRandomNum(wordsCount)
    
    Debug.Print "UBound(arrListedRandomNum): " & UBound(arrListedRandomNum)

    
    For i = 0 To UBound(arrListedRandomNum) - 1
        arrListedRandomNum(i) = i
    Next i
    
    
    '''数字が入った配列の中身を並べ替える。0,1,2,3,4,5の6回。0~6で生成。
    For i = 0 To UBound(arrListedRandomNum) - 1
        Call Randomize
        randomRowNum = Int((UBound(arrListedRandomNum) - 1 - 0 + 1) * Rnd + 0)

        Debug.Print "randomRowNum: " & randomRowNum
        
        ''最小値
        '3
        ''最大値
        '313
        Debug.Print "arrListedRandomNum(i): " & arrListedRandomNum(i)
        Debug.Print "arrListedRandomNum(randomRowNum): " & arrListedRandomNum(randomRowNum)
        
        tmp = arrListedRandomNum(i)
        arrListedRandomNum(i) = arrListedRandomNum(randomRowNum)
        arrListedRandomNum(randomRowNum) = tmp
        
        
    Next i
    
    For i = 0 To UBound(arrListedRandomNum) - 1
        wordRowNum = arrListedRandomNum(i) + 3
        wordValue = ActiveSheet.Cells(wordRowNum, 1).Value
        
        
        Call Question(wordValue, wordRowNum)
        
        
        If i = 0 Then
            Debug.Print "1問目です。"
        ElseIf ((i + 1) Mod 10) = 0 Then
            MsgBox ((i + 1) & "問解きました。すごいです!")
        End If
    Next i
    
    Debug.Print "wordRowNum: " & wordRowNum
    
    MsgBox ("すべて解き終わりました。お疲れさまでした。")
        
End Sub




Function Question(each_word, quesRowNum)
    Dim strIn As String
    
    strIn = InputBox("問題です!" & vbLf & vbLf & each_word & "の意味は何ですか?")
    
    If strIn = "" Then
        End
    End If
    
    Call CorrectOrIncorrect(strIn, quesRowNum)
    
End Function

Function CorrectOrIncorrect(strIn, quesRowNum)
    Dim corOrInc As String
    
    Dim strCorCount As String
    Dim strIncCount As String
     
    strCorCount = ActiveSheet.Cells(quesRowNum, 3).Value
    strIncCount = ActiveSheet.Cells(quesRowNum, 4).Value
    
    If strCorCount = "" Then
        strCorCount = "0"
    End If
    
    If strIncCount = "" Then
        strIncCount = "0"
    End If
    
    
    corOrInc = MsgBox("正解しましたか?" & vbLf & vbLf & "問題:" & ActiveSheet.Cells(quesRowNum, 1).Value & vbLf & vbLf & "正解:" & ActiveSheet.Cells(quesRowNum, 2).Value & vbLf & vbLf & "あなたの回答:" & strIn & vbLf, vbYesNo)
    
    Debug.Print corOrInc
    
    
    If corOrInc = vbYes Then
        ActiveSheet.Cells(quesRowNum, 3).Value = Str(Int(strCorCount) + 1)
    ElseIf corOrInc = vbNo Then
        ActiveSheet.Cells(quesRowNum, 4).Value = Str(Int(strIncCount) + 1)
    End If
    
End Function

終わりに

このVBAには、以下のようなメリットがあると考えています。
・広告なしで利用できる
・オフラインで実行できる
・必要なアプリケーションはExcelだけである
・単語・用語と意味の追加が容易である

デメリットは以下のようなものがあります。
・基本的にはスマホで使えない
・マクロを使い慣れていない方にとっては、セキュリティ上の不安を感じる

パソコンをメインに使って学習している方には良いアプローチなのではないかと思っています。

まだまだ勉強中であるため、ご意見や改善点がありましたら、コメントを頂けると嬉しいです。

修正点

・タイトル
・ソースコード(回答のダイアログボックスで問題の単語・用語も表示するようにしました。)
・「終わりに」にデメリットの項目の追加
・ソースコード(不具合の修正)
・Randomize -> Call Randomize

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?