月曜日, 4月 10, 2023

Excel VBA 11 
現実的な繰り返し処理の流れを把握

今回はスポット的な処理ではなく、現実的な一気処理について整理してみました。

上の表に対して以下のVBAを実行すると・・・
--------------------
Sub 試験結果の合計()
Range("F3").Select
'F3セルを選択
Do Until ActiveCell.Offset(0, -1).Value = ""
'アクティブセルの1つ左隣のセルが空欄になるまで処理を繰り返す
With ActiveCell
'以下の構文でWithステートメントを開始
.Value = .Offset(0, -3).Value + .Offset(0, -2).Value _
+ .Offset(0, -1).Value
'アクティブセルに3つ左隣の値、2つ左隣の値、1つ左隣の値を加算
.Offset(1, 0).Select
'アクティブセルの1行下のセルを選択
End With
'Withステートメントを終了
Loop
'Do〜Loopステートメントを終了
End Sub
--------------------

上は処理結果です。処理結果に対して以下のVBAで判定を行ってみます。
--------------------
Sub 試験結果の合否()
If Range("F3").Value >= 270 Then
Range("G3").Value = "S合格です。"
'F3の値が270以上であればG3に「S合格です。」を表示
ElseIf Range("F3").Value >= 240 Then
Range("G3").Value = "A合格です。"
'F3の値が240以上であればG3に「A合格です。」を表示
ElseIf Range("F3").Value >= 210 Then
Range("G3").Value = "B合格です。"
'F3の値が210以上であればG3に「B合格です。」を表示
ElseIf Range("F3").Value >= 180 Then
Range("G3").Value = "C合格です。"
'F3の値が180以上であればG3に「C合格です。」を表示
Else
Range("G3").Value = "再試験を受けてください。"
'それ以外はG3に「再試験を受けてください。」を表示
End If
End Sub
--------------------

上は処理結果です。ただし、G3セルだけの処理です。

これをG13セルまで繰り返すVBAを実行すると・・・

※ここから今までのようにA列と1行目を空けて作成することを止めました。これについては後日整理しますが、VBAの記述内容によってA列と1行目を空けて作成すると誤動作することが判明しました。
--------------------
Sub 成績確定_A()
Dim wks As Worksheet 'wksはWorksheet
Set wks = Worksheets("成績表2")
'wksはWorksheetsの成績表
Dim i As Long 'i(行)は整数
For i = 2 To wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
'i(行)の(データのある)最後の行まで続ける
If wks.Cells(i, 5) >= 270 Then
wks.Cells(i, 6) = "S合格です"
'E3の値が270以上であればF3に「S合格です」を表示
ElseIf wks.Cells(i, 5) >= 240 Then
wks.Cells(i, 6) = "A合格です"
'E3の値が240以上であればF3に「A合格です」を表示
ElseIf wks.Cells(i, 5) >= 210 Then
wks.Cells(i, 6) = "B合格です"
'E3の値が210以上であればF3に「B合格です」を表示
ElseIf wks.Cells(i, 5) >= 180 Then
wks.Cells(i, 6) = "C合格です"
'E3の値が180以上であればF3に「C合格です」を表示
Else '次の条件
wks.Cells(i, 6).Font.Color = RGB(255, 0, 0) ' F3の文字を赤
wks.Cells(i, 6) = "再試験です"
'それ以外はG3に「再試験です」を赤で表示
End If 'if文の最後
Next '繰り返す
End Sub
--------------------

上は処理結果です。

各科目の得点が60点以上で、3科目の合計点が200点を超過している場合のみ合格とする場合は・・・
--------------------
Sub 成績確定_B()
Dim wks As Worksheet
Set wks = Worksheets("成績表")
Dim i, j, k As Long
'i(行), j(列), k(科目毎の得点)は整数
For i = 2 To wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
'2行目からスタートし、最後のセルまで処理を繰り返す
'Cells(wks.Rows.Count, 1).End(xlUp) ← 最後のセルを表す
For j = 2 To 4
'2列目(B列)から4列目(D列)までの繰り返し
If wks.Cells(i, j) < 60 Then
'最初のセル(B2)が60未満であれば
k = 0 'kを0とする
'3科目のテストなのでこれにより1科目が60未満で0点で
'残りの科目が全て100点で200点となっても「不合格」になる。
Exit For
'Exitステートメントでループを抜ける
End If 'if文の最後
k = k + wks.Cells(i, j)
'k(科目毎の得点)にk(科目毎の得点)を加える
Next '繰り返す
wks.Cells(i, 6).Font.Color = RGB(255, 0, 0) ' F3の文字を赤
wks.Cells(i, 6) = "不合格"
'F2セル[wks.Cells(i, 6)]に「不合格」を記述
If k > 200 Then
'もしkが200を超過したら
wks.Cells(i, 6).Font.Color = RGB(0, 0, 0) ' F3の文字を黒
wks.Cells(i, 6) = "合格"
''F2セル[wks.Cells(i, 6)]に「合格」を記述
End If 'if文の最後
Next '繰り返す
End Sub
--------------------

上は処理結果です。