'***************************************************************************************************
' 単純なループ処理のサンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/23(1.00)新規作成
'16/11/19(1.10)*.xlsm化
'20/01/17(1.11)記述整理等
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ シート上のボタン起動処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST1
'* 機能 :単純なインデックスの繰り返し
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST1()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
' 行が2~101まで№をA列にセットする
For lngRow = 2 To 101
' 行から1を引いた値をA列にセットする
Cells(lngRow, 1).Value = (lngRow - 1)
Next lngRow
End Sub
'***************************************************************************************************
'* 処理名 :TEST2
'* 機能 :インデックス加減算順位を明示する
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST2()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
' 一番後ろの入力セルを探す(この方法は効率が悪い!⇒動作の説明のためのものです)
For lngRow = ActiveSheet.Rows.Count To 1 Step -1
' A列に有効データが見つかったら抜ける(Exit For)
If Cells(lngRow, 1).Value <> "" Then Exit For
Next lngRow
' 最終行の表示
MsgBox "最終行は" & lngRow & "行です"
End Sub
'***************************************************************************************************
'* 処理名 :TEST3
'* 機能 :シート初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST3()
'-----------------------------------------------------------------------------------------------
Rows("1:" & ActiveSheet.Rows.Count).ClearContents
ActiveWindow.ScrollRow = 1
Range("$A$1").Select
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
'***************************************************************************************************
' ワークシートを順次取得するループ処理 Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/23(1.00)新規作成
'16/11/19(1.10)*.xlsm化
'20/01/17(1.11)記述整理等
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ シート上のボタン起動処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST3
'* 機能 :このワークブックのシート名を順次表示する
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST3()
'-----------------------------------------------------------------------------------------------
Dim objSh As Worksheet ' ワークシート(Object)
' ワークシートオブジェクトを順次取得する(あるだけ全て)
For Each objSh In ThisWorkbook.Worksheets
' シート名を表示
MsgBox "シート名=" & objSh.Name
Next objSh
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
'***************************************************************************************************
' 単純なループ処理のサンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/23(1.00)新規作成
'16/11/19(1.10)*.xlsm化
'20/01/17(1.11)記述整理等
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ シート上のボタン起動処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST1
'* 機能 :単純なインデックスの繰り返し
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST1()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
' 行が2~101まで№をA列にセットする
lngRow = 2
Do While lngRow <= 101
' 行から1を引いた値をA列にセットする
Cells(lngRow, 1).Value = (lngRow - 1)
' 次の行へ
lngRow = lngRow + 1
Loop
End Sub
'***************************************************************************************************
'* 処理名 :TEST2
'* 機能 :インデックス加減算順位を明示する
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST2()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
lngRow = ActiveSheet.Rows.Count
' 一番後ろの入力セルを探す(この方法は効率が悪い!⇒動作の説明のためのものです)
Do While lngRow >= 1
' A列に有効データが見つかったら抜ける(Exit Do)
If Cells(lngRow, 1).Value <> "" Then Exit Do
' 前の行へ
lngRow = lngRow - 1
Loop
' 最終行の表示
MsgBox "最終行は" & lngRow & "行です"
End Sub
'***************************************************************************************************
'* 処理名 :TEST3
'* 機能 :シート初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST3()
'-----------------------------------------------------------------------------------------------
Rows("1:" & ActiveSheet.Rows.Count).ClearContents
ActiveWindow.ScrollRow = 1
Range("$A$1").Select
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
'***************************************************************************************************
' 判断文のサンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/23(1.00)新規作成
'16/11/19(1.10)*.xlsm化
'20/01/17(1.11)記述整理等
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ シート上のボタン起動処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST4
'* 機能 :判断文のサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST4()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
Dim strMSG As String ' メッセージWORK
' 現在の選択行を取得する
lngRow = ActiveCell.Row
' 選択行は奇数か(Modは剰余を算出)
If (lngRow Mod 2) <> 0 Then
strMSG = "この行は奇数、"
' さらに3で割り切れるか
If (lngRow Mod 3) <> 0 Then
strMSG = strMSG & "でも3で割り切れない"
Else
strMSG = strMSG & "しかも3で割り切れる"
End If
Else
strMSG = "この行は偶数、"
' さらに3で割り切れるか
If (lngRow Mod 3) <> 0 Then
strMSG = strMSG & "でも3で割り切れない"
Else
strMSG = strMSG & "けれど3で割り切れる"
End If
End If
' メッセージ表示
MsgBox strMSG
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
'***************************************************************************************************
' 判断・分岐処理のサンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/23(1.00)新規作成
'16/11/19(1.10)*.xlsm化
'20/01/17(1.11)記述整理等
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ シート上のボタン起動処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST5
'* 機能 :判断・分岐処理のサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST5()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
Dim strMSG As String ' メッセージWORK
' 現在の選択行を取得する
lngRow = ActiveCell.Row
' 選択行は奇数かさらに3で割り切れるか(Modは剰余を算出)
If (((lngRow Mod 2) <> 0) And ((lngRow Mod 3) <> 0)) Then
' 奇数でかつ3で割り切れない
strMSG = "この行は奇数、でも3で割り切れない"
ElseIf (((lngRow Mod 2) <> 0) And ((lngRow Mod 3) = 0)) Then
' 奇数でかつ3で割り切れる
strMSG = "この行は奇数、しかも3で割り切れる"
ElseIf (((lngRow Mod 2) = 0) And ((lngRow Mod 3) <> 0)) Then
' 偶数でかつ3で割り切れない
strMSG = "この行は偶数、けれど3で割り切れない"
Else
' 偶数でかつ3で割り切れる
strMSG = "この行は偶数、でも3で割り切れる"
End If
' メッセージを表示
MsgBox strMSG
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
'***************************************************************************************************
' 判断・分岐処理(多分岐)のサンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/24(1.00)新規作成
'16/11/19(1.10)*.xlsm化
'20/01/17(1.11)記述整理等
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ シートからの起動処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST6
'* 機能 :判断・分岐処理のサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST6()
'-----------------------------------------------------------------------------------------------
' A1セルに評価点を入れる
Select Case Cells(1, 1).Value
Case 100: MsgBox "満点です。おめでとう!!"
Case 99: MsgBox "ほとんど満点です。おめでとう!!"
Case Is >= 95: MsgBox "おしい!!次でがんばろう!"
Case Is >= 90: MsgBox "上出来です。今度はもっとがんばろう!"
Case Is >= 80: MsgBox "一応、上位ですが「天狗」にならないように"
Case Is >= 50: MsgBox "中くらいです。"
Case Is >= 30: MsgBox "良くありません。"
Case Else: MsgBox "やり直してきなさい!"
End Select
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
'***************************************************************************************************
' 判断・分岐処理のサンプル Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/06/23(1.00)新規作成
'16/11/19(1.10)*.xlsm化
'20/01/17(1.11)記述整理等
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ シート上のボタン起動処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST5_2
'* 機能 :判断・分岐処理のサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年06月23日
'* 作成者 :井上 治
'* 更新日 :2020年01月17日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST5_2()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
Dim strMSG As String ' メッセージWORK
' 現在の行を取得する
lngRow = ActiveCell.Row
' 現在行は奇数かさらに3で割り切れるか(Modは剰余を算出)
Select Case True
Case (((lngRow Mod 2) <> 0) And ((lngRow Mod 3) <> 0))
' 奇数でかつ3で割り切れない
strMSG = "この行は奇数、でも3で割り切れない"
Case (((lngRow Mod 2) <> 0) And ((lngRow Mod 3) = 0))
' 奇数でかつ3で割り切れる
strMSG = "この行は奇数、しかも3で割り切れる"
Case (((lngRow Mod 2) = 0) And ((lngRow Mod 3) <> 0))
' 偶数でかつ3で割り切れない
strMSG = "この行は偶数、けれど3で割り切れない"
Case Else
' 偶数でかつ3で割り切れる
strMSG = "この行は偶数、でも3で割り切れる"
End Select
' メッセージ表示
MsgBox strMSG
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
Range("A1").Interior.ColorIndex = 6
Range("A1").Interior.Color = vbYellow
'***************************************************************************************************
' 単純なインデックスの繰り返し
'***************************************************************************************************
Sub TEST1()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
' 行が2~101まで№をA列にセットする
For lngRow = 2 To 101
' 行から1を引いた値をA列にセットする
Cells(lngRow, 1).Value = (lngRow - 1)
Next lngRow
End Sub
'***************************************************************************************************
' 単純なインデックスの繰り返し(組み合わせの前段階)
'***************************************************************************************************
Sub TEST7_1()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
Dim lngBANGOU As Long ' 番号
' 行が2~101まで№をA列にセットする
For lngRow = 2 To 101
' 行から1を引いた値をA列にセットする
lngBANGOU = lngRow - 1
Cells(lngRow, 1).Value = lngBANGOU
Next lngRow
End Sub
' BANGOUは偶数でかつ3で割り切れるか(Modは剰余を算出)
If (((lngBANGOU Mod 2) = 0) And ((lngBANGOU Mod 3) = 0)) Then
'***************************************************************************************************
' 繰り返しと判断・分岐の組み合わせ処理
'***************************************************************************************************
Sub TEST7_2()
'-----------------------------------------------------------------------------------------------
Dim lngRow As Long ' 行INDEX
Dim lngBANGOU As Long ' 番号
' 行が2~101まで一連番号をA列にセットする
For lngRow = 2 To 101
' 行から1を引いた値(一連番号)をA列にセットする
lngBANGOU = lngRow - 1
Cells(lngRow, 1).Value = lngBANGOU
' 一連番号が偶数でかつ3で割り切れるか(Mod関数は剰余を算出)
If (((lngBANGOU Mod 2) = 0) And ((lngBANGOU Mod 3) = 0)) Then
' 割り切れる時は黄色で塗りつぶし
Cells(lngRow, 1).Interior.ColorIndex = 6
End If
Next lngRow
End Sub
※業務の仕様要件い対して、コードの組み立てを考えていくことは自分で問題を作成して回答を作ることでもあり難しいことですが、その段階まで来ている人は「仕様要件からコードの組み立てを考える。」をご覧下さい。