【Excel VBA 練習】VBAで計算ドリルを作成する

VBAの練習として、計算ドリルを作ってみました。

【目次】

計算ドリルの使い方の説明

以下のような計算ドリル用のExcelのシートになっています。

■問題の種類選択
問題の種類選択のセルE2が「加算、減算、乗算、除算」のリストになっていて、問題の種類を選択できます。

■回答開始
「回答開始」をクリックすると問題が作成されます。
メッセージボックスで「OK」を選択すると、セルH2に開始時間が入力されます。
この状態でG列に回答を入力していきます。
※「回答開始」ボタンを押すと、前回の問題、回答、正解、得点、開始時間、終了時間、かかった時間がクリアされて、新しい問題が作成されます。
※「回答開始」ボタンは四角形の図形にマクロ(calculationDrill)を登録しています。

■回答終了・採点
回答が終わったら、「採点」ボタンを押します。採点ボタンを押すとセルH9:H28までに正解なら「○」、不正解なら正しい値が入力されます。
セルH29に得点が入力されます。
セルH3:H4には「採点」ボタンを押した時間と、開始時間から終了時間までの時間が入力されます。
※「採点」ボタンは四角形の図形にマクロ(calculationDrill)が登録されています。

■注意点
除算の場合は割り切れない問題があります。
その場合は、小数点第2位以下を切り捨てた、小数点第1位までの値を正解とします。

■「クリア」ボタン
「クリア」ボタンは、問題、回答、得点、開始時間、終了時間、かかった時間をクリアするボタンです。
「クリア」ボタンは四角形の図形にマクロ(dataClear)というマクロが登録されています。

計算ドリルのVBAのコード

以下のようなコードを書きました。

Sub calculationDrill()
    
    Call dataClear
    
    '最終行の取得
    Dim maxCol As Long: maxCol = Cells(Rows.Count, 2).End(xlUp).Row
    
    '問題の種類、演算子の入力
    Dim strKind As String: strKind = Cells(2, 5)
    Dim strBuff As String
    
    Select Case strKind
        Case "加算"
            strBuff = "＋"
        Case "減算"
            strBuff = "－"
        Case "乗算"
            strBuff = "×"
        Case "除算"
            strBuff = "÷"
    End Select
    
    '問題の種類に応じた演算子を入力
    Dim i As Long
    
    For i = 9 To maxCol
        Cells(i, 3) = Int(Rnd() * 10) + 1
        Cells(i, 4) = strBuff
        Cells(i, 5) = Int(Rnd() * 10) + 1
        Cells(i, 6) = "="
    Next i

    MsgBox "Start", vbOKOnly, "計算問題"
    Cells(2, 8) = Now()
       
End Sub


Sub pickingPoints()
    
    '終了時間、かかった時間の取得
    Cells(3, 8) = Now()
    Cells(4, 8) = Cells(3, 8) - Cells(2, 8)

    '最終行の取得
    Dim maxCol As Long: maxCol = Cells(Rows.Count, 2).End(xlUp).Row
      
    Dim i As Long
    Dim lScore As Long
    
    For i = 9 To maxCol
        Cells(i, 8) = "=" & Cells(i, 3) & Cells(i, 4) & Cells(i, 5)
        Cells(i, 8).Value = Application.WorksheetFunction.RoundDown(Cells(i, 8).Value, 1)
        
        If Cells(i, 8) = Cells(i, 7) Then
            Cells(i, 8) = "○"
            lScore = lScore + 5
        Else
            Cells(i, 8).Font.Color = RGB(255, 0, 0)
        End If
    Next i

    Cells(29, 8) = lScore
    If Cells(29, 8) < 70 Then
        Cells(29, 8).Font.Color = RGB(255, 0, 0)
        MsgBox lScore & "点です。頑張りましょう！"
    Else
        MsgBox lScore & "点です。よくできました！"
    End If

End Sub


Sub dataClear()
    Range("C9:H28").ClearContents
    Range("H2:H4").ClearContents
    Range("H29").ClearContents
    Range("H9:H29").Font.Color = RGB(0, 0, 0)
End Sub

もしよければ試してみてください。
以上、お読みいただきありがとうございました。

【Excel VBA 練習】必要な列が重複なく存在することを確認するマクロ ~動的配列の練習~

以下の記事では、静的配列を使ってデータに必要な列が重複なく存在することを確認するマクロを作成しました。
auroralights.jp
ただし、上記の記事のマクロではチェックする『必要な列』をVBAのコードに直接記載しているため、チェックする列名が変わったり、チェックする列数が増えたりする都度コードを変更する必要がありました。
今回は動的配列を使って『必要な列』を別シートから取得するようにして、コードを変更せずにチェックする列名・列数の変更に対応するマクロを作成します。

【目次】

目的

シートに必要な列が重複せずに存在するかどうかを確認できるマクロを作成することが目的です。
以下のように「data」シートと「check」シートがあり、「data」シートにはチェックするデータがあります。
「check」シートのA列には「data」シートに存在していることを確認する必須の列名を入力します。
マクロを実行すると「check」シートのA列の列名が「data」シートにあることを確認します。

＜データの定義＞

• dataシートには、チェックするデータが入力されている
• checkシートのA列2行目以降にdataシートに存在するかどうかを確認する必須の列名が入力されている
• checkシートのA列の必須列名の数は可変である

必要な列が重複せずに存在するかどうかを確認するVBAのコード

以下のようなコードを書きました。

Sub checkCol2()

    'dataシート、checkシートをオブジェクト変数に格納
    Dim wsData As Worksheet
    Dim wsCheck As Worksheet
    Set wsData = ThisWorkbook.Worksheets("data")
    Set wsCheck = ThisWorkbook.Worksheets("check")

    '配列に格納する必須列名の要素番号を取得する
    'checkシートの見出し行を除く、配列は0から始まるため、A列の最終行-2で求める
    Dim checkCol As Long
    checkCol = wsCheck.Cells(Rows.Count, 1).End(xlUp).Row - 2
    

    '動的配列の宣言と必須列名の格納
    Dim arrCheckCol() As String
    ReDim arrCheckCol(checkCol)
    
    'For文用の変数宣言
    Dim i As Long
    Dim j As Long: j = 0
    
    '配列に必須列名を格納する
    For i = 2 To wsCheck.Cells(Rows.Count, 1).End(xlUp).Row
        arrCheckCol(j) = wsCheck.Cells(i, 1)
        j = j + 1
    Next i

    'dataシートの最終列の取得
    Dim maxCol As Long: maxCol = wsData.Cells(1, Columns.Count).End(xlToLeft).Column

    'dataシートに必須列名が重複なく存在するかどうかチェック
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim msg As String
    
    '配列の要素数だけループ
    For x = LBound(arrCheckCol) To UBound(arrCheckCol)
        'A列から最終列までループ
        For y = 1 To maxCol
            If wsData.Cells(1, y) = arrCheckCol(x) Then
                z = z + 1
            End If
        Next y
        
       '重複・存在結果を格納
        If z < 1 Then
            msg = msg & arrCheckCol(x) & "列がありません" & vbCr
        ElseIf z > 1 Then
            msg = msg & arrCheckCol(x) & "列が" & z & "列存在。重複しています" & vbCr
        Else
            msg = msg & arrCheckCol(x) & "列：OK" & vbCr
        End If
        z = 0
    Next x

    MsgBox msg
    
End Sub

考え方

■オブジェクト変数wsData、wsCheckの宣言
「wsData」、「wsCheck」にマクロを記述しているブックの「data」シート、「check」シートを格納します。

    Dim wsData As Worksheet
    Dim wsCheck As Worksheet
    Set wsData = ThisWorkbook.Worksheets("data")
    Set wsCheck = ThisWorkbook.Worksheets("check")

■配列に格納する必須列名の要素数の取得、動的配列の宣言
「check」シートのA列に必須列名が記載されています。
最初の1行は列見出しのため不要。さらに配列は0から始まるので、「check」シートの最終行数-2で配列に指定する最大要素数を取得しました。

arrCheckCol()という動的配列を宣言し、ReDimでarrCheckColの要素数を指定します。
要素数には、checkシートの最終行数-2の値を格納している変数checkColを使います。

    '配列に格納する必須列名の要素番号を取得する
    'checkシートの見出し行を除く、配列は0から始まるため、A列の最終行-2で求める
    Dim checkCol As Long
    checkCol = wsCheck.Cells(Rows.Count, 1).End(xlUp).Row - 2
    

    '動的配列の宣言と必須列名の格納
    Dim arrCheckCol() As String
    ReDim arrCheckCol(checkCol)

■配列に必須列名を格納する
配列「arrCheckCol」に「check」シートのA列2行目以降の必須列名を格納します。

    'For文用の変数宣言
    Dim i As Long
    Dim j As Long: j = 0
    
    '配列に必須列名を格納する
    For i = 2 To wsCheck.Cells(Rows.Count, 1).End(xlUp).Row
        arrCheckCol(j) = wsCheck.Cells(i, 1)
        j = j + 1
    Next i

■dataシートの最終列の取得
変数maxColに「data」シートの最終列数を格納します。

    'dataシートの最終列の取得
    Dim maxCol As Long: maxCol = wsData.Cells(1, Columns.Count).End(xlToLeft).Column

■dataシートの最終列の取得
配列に格納した必須列名の数だけ、dataシートの1行目のA列～最終列までに必須列名が重複なく存在するかどうかをチェックします。
チェックした結果を変数msgに格納します。

    'dataシートに必須列名が重複なく存在するかどうかチェック
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim msg As String
    
    '配列の要素数だけループ
    For x = LBound(arrCheckCol) To UBound(arrCheckCol)
        'A列から最終列までループ
        For y = 1 To maxCol
            If wsData.Cells(1, y) = arrCheckCol(x) Then
                z = z + 1
            End If
        Next y
        
       '重複・存在結果を格納
        If z < 1 Then
            msg = msg & arrCheckCol(x) & "列がありません" & vbCr
        ElseIf z > 1 Then
            msg = msg & arrCheckCol(x) & "列が" & z & "列存在。重複しています" & vbCr
        Else
            msg = msg & arrCheckCol(x) & "列：OK" & vbCr
        End If
        z = 0
    Next x

■Msgboxで結果を出力
メッセージボックスで必須列名が重複なく存在するかどうかを表示します。

    MsgBox msg

以下のようなメッセージを表示します。

あとがき

今回は動的配列の練習もかねて、あえて配列を使ってVBAを書きました。
よくよく考えると、わざわざ配列に調べる必須列を格納しなくても、checkシートのA列の値とdataシートの列名を照らし合わせた方がシンプルで可読性もよくなると思いました。

以上、お読みいただきありがとうございました。

【Excel VBA 練習】必要な列が重複なく存在することを確認するマクロ ~静的配列の練習~

【目次】

※2021/10/12：列の重複の観点が漏れていたのでコードを修正しました。

以下の記事では動的配列を使って、必要な列が存在するかどうか確認するマクロを紹介しています。
auroralights.jp

目的

以下の画像のようなデータの1行目に必要な列が存在するかどうか確認することが目的です。

応用として、データ集計などのVBAツールを作成する際に、元データに必要な列があるかどうかをチェックするための機能に使えたら良いなと思っています。

＜データの定義＞

• データはVBAを記述するブックと同じブックのSheet1に存在します。
• 1行目がデータの列名になります。
• データはA1が開始点となります。
• 今回は「受注番号」「商品コード」「受注日」「納入日」「見積番号」「担当者」の6つの列が存在することを確認します。

必要な列があるかどうか確認するVBAのコード

以下のようなコードを書きました。

Option Explicit

Sub checkCol()

    '配列に必要な列名を格納
    Dim arrCol(5) As String
    arrCol(0) = "受注番号"
    arrCol(1) = "商品コード"
    arrCol(2) = "受注日"
    arrCol(3) = "納入日"
    arrCol(4) = "見積番号"
    arrCol(5) = "担当者"
        
    '最終列の取得
    Dim maxCol As Long: maxCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    'for文用カウント変数i、j、列の存在・重複確認用の変数k、メッセージ用の変数msgの宣言
    Dim i As Long, j As Long, k As Long
    Dim msg As String
    
    '配列の要素数だけ、A列～最終列のチェックを繰り返す
    For i = LBound(arrCol) To UBound(arrCol)
        For j = 1 To maxCol
            If Cells(1, j) = arrCol(i) Then
                k = k + 1
            End If
        Next j
        
        If k = 1 Then
            msg = msg & arrCol(i) & ":OK" & vbCr
        ElseIf k < 1 Then
            msg = msg & arrCol(i) & "が存在しません" & vbCr
        Else
            msg = msg & arrCol(i) & "が" & k & "列存在。重複しています。" & vbCr
        End If
        k = 0
    Next i
    
    '結果の表示
    MsgBox msg
    
End Sub

考え方

■配列への必要な列名の格納
必要な6つの列名(「受注番号」「商品コード」「受注日」「納入日」「見積番号」「担当者」)を「arrCol」という配列に格納します。

■最終列数の取得
データの最終列(右端の列数)を「maxCol」という変数に格納します。

■for文用カウント変数i、j、列の存在・重複確認用の変数k、メッセージ用の変数msgの宣言
for文用の変数i、j、列の存在・重複確認用の変数k、メッセージ用の変数msgを宣言します。

■for文で配列の要素数分、A列～最終列のチェックを繰り返す
配列arrCol(0)に格納されている列名「受注番号」がSheet1の1行目のA列～最終列までに存在する数だけ変数「k」に1をプラスします。
(存在しなければ1はプラスしません)

kが1ならOK、kが0ならarrCol(0)の列名が存在しない、それ以外ならarrCol(0)の列名が重複しているとメッセージ用の変数msgに格納し、kに0を再設定します。

同じようにarrCol(1)~arrCol(5)に格納されている列名が、1行目のA列～最終列までに存在するかどうかをチェックして、変数msgに結果を継ぎ足します。

■結果の表示
配列arrColに格納したすべての列名が1つずつ存在する場合は、以下のようなメッセージが表示されます。

配列arrColに格納した列名で、重複する列名や存在しない列名がある場合は、以下のようなメッセージでどの列が重複、存在していないかわかるようにしました。

以上、お読みいただきありがとうございました。