EXCEL VBA内で多く利用されるFor Next ステートメントですが、今回は、For NextStepの利用方法の応用編という事で、様々な形で利用されているFor Nextの利用方法をサンプルプログラムを交えて説明したいと思います。For文と言えば、基本プログラム内では繰り返し処理に利用されます。セルの参照先を移動したり、数値を繰り返して合計値などを計算したりする事に利用されます。今回は、基礎では説明が出来なかったテクニック部分を含めて説明をいたします。
●For Nextステートメントの基礎については、下記のURLを参照して下さい。
https://akira55.com/fornext/
'
'******** AKIRA55.COM ******* https://akira55.com/fornextstep02/
'
Sub fornext01()
Dim I As Long
For I = 2 To 15 '２列目から１５列目まで繰り返します。
If Range("C" & I) < 5000 Then 'C列のデータが5000未満でループから抜けます。
Exit For 'ループから抜ける
End If
Range("D" & I) = "500万人以上" 'C列のデータが5000以上なら
Next I
End Sub
'
'
'******** AKIRA55.COM ******* https://akira55.com/fornextstep02/
'
Sub fornext02() '氏名の一覧データからフリガナ毎に振り分ける （For文とSelect caseとの組み合わせ）
Dim I, F1, F2, F3, F4 As Long
Dim HIRA As String
F1 = 2
F2 = 2
F3 = 2
F4 = 2
For I = 2 To 21 '2列目から21列名まで繰り返します。
HIRA = Left(Range("C" & I), 1) 'C列のフリガナの１文字目を取得（左から一文字目）
Select Case HIRA
Case "ｱ" To "ｵ" 'ア行
Range("F" & F1) = Range("B" & I) 'ア行の氏名をF列に記入
F1 = F1 + 1 'F列の行を一行加算
Case "ｶ" To "ｺ" 'カ行
Range("G" & F2) = Range("B" & I) 'カ行の氏名をG列に記入
F2 = F2 + 1 'G列の行を一行加算
Case "ｻ" To "ｿ" 'サ行
Range("H" & F3) = Range("B" & I) 'サ行の氏名をH列に記入
F3 = F3 + 1 'H列の行を一行加算
Case Else 'その他
Range("I" & F4) = Range("B" & I) 'その他をI列に記入
F4 = F4 + 1 'I列の行を一行加算
End Select
Next I
End Sub
'
'
'******** AKIRA55.COM ******* https://akira55.com/fornextstep02/
'
Sub fornext03() '氏名の一覧データか男性と女性に振り分ける （For文とIF文との組み合わせ）
Dim I, M1, W1 As Long
Dim SEIBETSU As String
M1 = 2
W1 = 2
For I = 2 To 21 '2列目から21列名まで繰り返します。
SEIBETSU = Range("D" & I)
If SEIBETSU = "男" Then
Range("F" & M1) = Range("B" & I)
M1 = M1 + 1
Else
Range("G" & W1) = Range("B" & I)
W1 = W1 + 1
End If
Next I
MsgBox "男性は、" & M1 - 2 & "名です。女性は、" & W1 - 2 & "名です。"
End Sub
'
下記のサンプルプログラムは、For文とIsEmptyを組み合わせたサンプルプログラムです。社員の一覧データを左表から右表に転記するプログラムです。左表から右表にデータを転記する際に、データに空白が有る場合は、スキップして転記します。
【転記条件】
●社員番号・氏名・住所いずれも記入されていれば、転記する。
'
'******** AKIRA55.COM ******* https://akira55.com/fornextstep02/
'
Sub fornext04() 'For文内に空白データを飛ばしてデータを転記する。
Dim I, L, CErr As Long
CErr = 0
L = 2
For I = 2 To 21 '2行目から21行目まで繰り返します。
If IsEmpty(Cells(I, "A")) = True Or IsEmpty(Cells(I, "B")) = True Or IsEmpty(Cells(I, "C")) = True Then 'データに空白があるかチェックします。
CErr = CErr + 1 '空白件数をカウント
Else
Range("E" & L & ":G" & L).Value = Range("A" & I & ":C" & I).Value '左表から右表からデータを転記します
L = L + 1 '転記先（右表）の行を＋１加算します。
End If
Next I
MsgBox "データに空白があった件数は、" & CErr & "件です"
End Sub
'
下記のサンプルプログラムは、For Next Stepでステップの間隔を小数点以下で利用する方法を説明いたします。今回のサンプルプログラムは、ドル円相場の0.25セント単位でドル円相場の価格を一覧として表示します。
Currency型：通貨型の変数を利用して増分を小数点で管理します。
【プログラム実行手順】
①現在のドル円価格をインプットボックスに入力します。
②For文で0.25セント単位で5ドルまで、ドル円価格を計算表示されます。
'
'******** AKIRA55.COM ******* https://akira55.com/fornextstep02/
'
Sub fornext05() '小数点以下でループさせる。１より小さい間隔でループ
Dim Doller As Currency
Dim L As Long
Dim Yen As Single
Yen = InputBox("現在のドル円は、")
L = 1
For Doller = 0.25 To 5 Step 0.25
Range("A" & L) = Doller
Range("B" & L) = Yen * Doller
Range("A" & L).NumberFormatLocal = "$0.00"
Range("B" & L).NumberFormatLocal = "#.00円"
L = L + 1
Next Doller
End Sub
'
'
'******** AKIRA55.COM ******* https://akira55.com/fornextstep02/
'
Sub fornext06() '指定した行間隔で背景色をつける。
Dim I, lRow, lCol, Srow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行取得
lCol = Cells(1, Columns.Count).End(xlToLeft).Column '1行目の最終列を取得
Range(Cells(2, 1), Cells(lRow, lCol)).Interior.ColorIndex = 0 '背景色をクリアー
Srow = InputBox("指定する背景色の行間隔を数値で入力")
For I = 2 To lRow Step Srow '入力した数値の間隔でループします。
Range(Cells(I, 1), Cells(I, lCol)).Interior.ColorIndex = 37 '指定した背景色でセルを塗りつぶします。
Next I
End Sub
'
下記のサンプルプログラムは、For文とGoto文を組み合わせたサンプルプログラムです。For文は、一定の処理を繰り返しますが、処理条件にもよりますがループ内処理を行いたくない事も有ると思いますが、この場合は、１例としてGoto文を利用してループ内処理を飛ばす事が出来ます。今回、説明するサンプルプログラムは、表のC列「連絡済み」が「済」の場合は、「氏名」の転記処理（E列に名前を転記）を飛ばす（スキップ）プログラムになります。
'
'******** AKIRA55.COM ******* https://akira55.com/fornextstep02/
'
Sub fornext07() 'ループ内の処理を飛ばす（Goto）
Dim I, L, lRow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行取得
L = 2
For I = 2 To lRow
If Range("C" & I) = "済" Then
GoTo Jump
End If
'－－－－－ループ内処理（未連絡リスト）
Range("E" & L) = Range("B" & I)
L = L + 1
'－－－－－－－－－－－－－－－－－－－－
Jump:
Next I
End Sub
'
