VBA　条件分岐　while文？

VBAで背景色をつけたい。エクセルの範囲を指定せずに、複数の条件分岐を実現したい

ここに質問の内容を詳しく書いてください。
かなり長文になると思いますが、色々試した結果、手詰まりになっているので質問します。

L列に行いたい処理を記載しているのですが、コードを書いて実行した結果、

こうなってしまいます。
実際に行いたい処理が

です。
そして、先輩には、仕事では特定のセル範囲のみに処理を表示させることはないから、セル範囲を指定せずに条件が合致している間は、処理を行えるようにしとほしいといわれていますが、なかなかうまくいきません。

該当のソースコード

'''
Sub Ara()
Dim a As Integer
Dim b As Integer

For a = 3 To 32
For b = 8 To 9

If Cells(a, 7) <> "" Then
    Cells(a, 8) = Cells(a, 7) + 1
    Cells(a, 9) = Cells(a, 7) + 2
    
    

     ElseIf Cells(a, b) Mod 2 = 0 And Cells(a, b) <> "" Then
    Cells(a, b).Interior.ColorIndex = 3

  
End If
Next b
Next a

End Sub
'''

試したこと

上記はfor文でセル範囲を指定しています。セル範囲を指定せずに条件に合致している間繰り返すということなのでwhile文を使用したのですが、うまくいきませんでした。

補足情報

文章が分かりにくいことは承知しています。
もし、ご回答いただけたら、助かります。

修正依頼がございましたので、追記致します。
「複数の条件分岐」という言葉では分からないとの事、言葉が足りませんでした。すみません。

要件といいますか実現したいことは、
条件１　G3～32に値が入っていたら、
処理（例　G3の値に＋1したものをH3に、G3の値に＋2したものをI3に）G4以降も同じ
条件2 値が入っていないところは
処理　空白
条件3　セルに偶数の値のみが入っている場合
処理　セルの背景色を赤色

以上をセル範囲を指定せずに、条件に当てはまる場合は繰り返す処理をしたいということです。

上記の文章でよいかは個人的に不安が残りますが、追記とさせていただきます。

m.ts10806

2018/05/05 03:39

コードはコードブロック```で囲ってください。また、「複数の条件分岐」というのは？要件として文章で補足で入れてください。

行動規範の内容に同意します

回答5件

hihijiji様のご指摘を活かさせていただき、
シートモジュール用のコードを書いてみました。

対象とするワークシートのシートモジュールに記述してください。
VBE内の「Sheet*(Sheet*)」です。
「Module*」ではありません。

Worksheet_Change()は予約されたイベントプロシージャで、
イベントがあるたび走査します。

VBA
1Private Sub Worksheet_Change(ByVal Target As Range)
2    
3    Dim a, b, row_end As Long
4    
5    '最終行を取得
6    row_end = Cells(Rows.Count, 7).End(xlUp).Row
7    
8    '入力がG列以外の場合はプローシージャを終了
9    If Intersect(Target, Range(Cells(3, 7), Cells(row_end, 7))) _
10    Is Nothing Then
11        Exit Sub
12    Else
13        For a = 3 To row_end
14            For b = 8 To 9
15                '入力値が空白の場合の処理
16                If Cells(a, 7).Value = "" Then
17                    Cells(a, b).ClearContents
18                    Cells(a, b).ClearFormats
19                '入力があった場合の処理
20                Else
21                    Cells(a, b).Value = _
22                    Cells(a, 7).Value + b - 7 'H列は+1、I列は+2
23                    If Cells(a, b).Value Mod 2 = 0 Then
24                        Cells(a, b).Interior.Color = RGB(255, 0, 0) '赤色
25                    Else
26                        Cells(a, b).ClearFormats '塗りつぶしなし
27                    End If
28                End If
29            Next b
30        Next a
31    End If
32
33End Sub

やはりコードをスッキリさせるためには
For～Next文は必要でした。すみませんでした。

投稿2018/05/05 13:20

3109

総合スコア80

退会済みユーザー

2018/05/06 01:26

ご解答ありがとうございます。シートモジュールは使用したことがないので不慣れな点があると思いますが、トライしてみます。ありがとうございます。

行動規範の内容に同意します

多分一々呼ぶのではなく、値の変更に動的に対応して欲しいってことだと思います。
標準モジュールではなく、ワークシートにイベント処理を書いてます。

VBA
1Private Sub Worksheet_Activate()
2    Call Worksheet_Change(ThisWorkbook.ActiveSheet.Range("G3:G32"))
3End Sub
4
5Private Sub Worksheet_Change(ByVal Target As Range)
6    Dim cell As Range
7    Dim targetCell As Range
8    Dim i As Integer
9    Dim inputValue As Long
10    
11    For Each cell In Target.Cells
12        If cell.Column = 7 And cell.Row >= 3 And cell.Row <= 32 Then 'G3 ~ G32 なら
13            For i = 1 To 2 'となりと、そのとなり
14                Set targetCell = cell.Offset(0, i)
15                If IsNumeric(cell.value) Then
16                
17                    inputValue = cell.value + i
18                    
19                    targetCell.value = inputValue
20                    
21                    If inputValue Mod 2 = 0 Then '偶数なら
22                        targetCell.Interior.Color = RGB(255, 0, 0) '背景を赤に
23                    End If
24                Else
25                    targetCell.value = ""
26                End If
27            Next i
28        End If
29    Next cell
30    
31End Sub

投稿2018/05/05 07:57

hihijiji

総合スコア4150

退会済みユーザー

2018/05/06 01:28

ご解答ありがとうございます。さっそくためしてみようと思います。シートモジュールは使ったことがないので調べながらやろうと思います。

行動規範の内容に同意します

ベストアンサー

すでに、いろいろな方法がでてますが、一例として。

vba
1Sub Ara()
2    Dim r As Range, c As Range, i As Long
3
4    Set r = Range(Range("G3"), Cells(Rows.Count, 7).End(xlUp))    '条件のセル範囲
5    r.Offset(, 1).Resize(, 2).Clear    '処理対象のセル範囲の値と書式のクリア
6
7    Set r = r.SpecialCells(xlCellTypeConstants)    '値のあるセルのみ取得
8    For Each c In r
9        For i = 1 To 2
10            With c.Offset(, i)
11                .Value = c.Value + i
12                If .Value Mod 2 = 0 Then .Interior.ColorIndex = 3
13            End With
14        Next
15    Next
16End Sub

追記

ワークシートのイベントプロシージャを使う方法が提案されているようなので、その場合の例。

vba
1Private Sub Worksheet_Change(ByVal Target As Range)
2    Dim cell As Range
3    Dim i As Long
4
5    For Each cell In Target
6        If cell.Column = 7 And cell.Row >= 3 Then
7            If cell.Value <> "" And IsNumeric(cell.Value) Then
8                For i = 1 To 2
9                    With cell.Offset(, i)
10                        .Value = cell.Value + i
11                        If .Value Mod 2 = 0 Then .Interior.ColorIndex = 3
12                    End With
13                Next
14            Else
15                cell.Offset(, 1).Resize(, 2).Clear
16            End If
17        End If
18    Next
19End Sub

ただ、ユーザーの入力に逐一反応するという仕様なら、セルに式と条件付き書式を設定する方法でもいいように思います。

※Cells(行,列) の絶対座標でセル位置を指定する方法と、Offsetで相対座標でセル位置を指定する方法がありますが、相対座標の場合、対象セル範囲が変更になったときも変更箇所が少なくてすみますので、私の場合はこちらで書く場合が多いです。

投稿2018/05/05 07:08

編集2018/05/06 01:20

hatena19

総合スコア33699

退会済みユーザー

2018/05/06 01:29

ご解答ありがとうございます。トライしてみます。ありがとうございます。

行動規範の内容に同意します

Sub Ara()
’型式をInteger => Longへ変更
Dim a As Long　
Dim b As Long
Dim c As Long

'最終行を取得
c = Cells(Rows.Count, 7).End(xlUp).Row

For a = 3 To c
For b = 8 To 9
If Cells(a, 7) <> "" Then
Cells(a, 8) = Cells(a, 7) + 1
Cells(a, 9) = Cells(a, 7) + 2
ElseIf Cells(a, b) Mod 2 = 0 And Cells(a, b) <> "" Then
Cells(a, b).Interior.ColorIndex = 3
End If
Next b
Next a

End Sub

提示分を、もとに「上方向に最終行を検索する」と考えました。
データの型は、データの範囲が不明なので変更しました。

投稿2018/05/05 04:29

kumaghrsh

総合スコア12

退会済みユーザー

2018/05/06 02:25

ご解答ありがとうございます。ご解答いただいた方で一番シンプルのコードだと思います。トライしてみます。

行動規範の内容に同意します

お役に立てるかわかりませんが、
私にできる限りでコードを書いてみました。

Sub Ara()

    Dim a As Integer
    Dim row_end As Integer
    row_end = Cells(Rows.Count, 7).End(xlUp).Row
    
    Range(Cells(3, 8), Cells(row_end, 9)).ClearContents
    Range(Cells(3, 8), Cells(row_end, 9)).Interior.ColorIndex = 0
    
    For a = 3 To row_end
        If Cells(a, 7).Value <> "" Then
            Cells(a, 8).Value = Cells(a, 7).Value + 1
            If Cells(a, 8).Value Mod 2 = 0 Then
                Cells(a, 8).Interior.ColorIndex = 3
            End If
            Cells(a, 9).Value = Cells(a, 7).Value + 2
            If Cells(a, 9).Value Mod 2 = 0 Then
                Cells(a, 9).Interior.ColorIndex = 3
            End If
        End If
    Next a

End Sub

・何行使うか決まっていない場合に備えて
最終行を変数に代入してあります。
・マクロ実行の度にH列I列をクリアします。
・For-Nextのネストは不要に思えたので削りました。

セルの色付けはもっとスマートな
書き方があるような気がします。

投稿2018/05/05 03:45

3109

総合スコア80