For文、If文の組み合わせをもっと簡潔に記載する方法について

下記で作動はするのですが、こういう感じのVBAをもっと簡潔に記載する方法はあるのでしょうか？
変数kが3ずつ増える、mが3ずつ増えるなど、規則性はあるので完結に書けそうなのですが、うまくいきません。



k＝58
For i = 11 To 57
    For j = 3 To 33
      For m = 58　To 60
        
              
    With ws1
        If .Cells(i, j) Like "*ウ*" And .Cells(k, j).Value = "0" Then        
         ws2.Cells(m, j).Interior.Color = RGB(255, 226, 121)
        
        End If
                
       If .Cells(i, j) Like "*ケ*" And .Cells(k + 3, j).Value = "0" Then    
         ws2.Cells(m + 3, j).Interior.Color = RGB(255, 226, 121)
        
        End If
        
       If .Cells(i, j) Like "*ク*" And .Cells(k + 6, j).Value = "0" Then        
          ws2.Cells(m + 6, j).Interior.Color = RGB(255, 226, 121)
        
        End If
        
        
       If .Cells(i, j) Like "*市*" And .Cells(k + 9, j).Value = "0" Then       
          ws2.Cells(m + 9, j).Interior.Color = RGB(255, 226, 121)
        
        End If
             
       If .Cells(i, j) Like "*任*" And .Cells(k + 12, j).Value = "0" Then       
          ws2.Cells(m + 12, j).Interior.Color = RGB(255, 226, 121)
        
        End If
        
        
       If .Cells(i, j) Like "*ピ*" And .Cells(k + 15, j).Value = "0" Then      
         ws2.Cells(m + 15, j).Interior.Color = RGB(255, 226, 121)
        
        End If
        
       If .Cells(i, j) Like "*ジ*" And .Cells(k + 18, j).Value = "0" Then        
          ws2.Cells(m + 18, j).Interior.Color = RGB(255, 226, 121)
        
        End If
        
       If .Cells(i, j) Like "*本*" And .Cells(k + 21, j).Value = "0" Then        
          ws2.Cells(m + 21, j).Interior.Color = RGB(255, 226, 121)
       
       End If
        
       If .Cells(i, j) Like "*武*" And .Cells(k + 24, j).Value = "0" Then     
          ws2.Cells(m + 24, j).Interior.Color = RGB(255, 226, 121)
       
       End If
     
　　　　　　　　　　　End With
        
     Next m           
   Next j
  Next i
'
End Sub
コード

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

回答2件

単純に「同じコードが複数回出ているのが違和感があるため省略したい」ってことであれば、「サブルーチン」にすればいいと思いますよ。「関数(function)」でもいいですけど。

ざっと見た感じ、

VBA
1        If .Cells(i, j) Like "*ウ*" And .Cells(k, j).Value = "0" Then        
2         ws2.Cells(m, j).Interior.Color = RGB(255, 226, 121)
3        
4        End If
5                
6       If .Cells(i, j) Like "*ケ*" And .Cells(k + 3, j).Value = "0" Then    
7         ws2.Cells(m + 3, j).Interior.Color = RGB(255, 226, 121)
8        
9        End If
10      ' ... (似たような感じのコードがずらり)

となっています。

この二つのIf文を抽象化して共通項を抜き出すと、

If .Cells(i, j) Like "*■*" And .Cells(▲, j).Value = "0" Then
    ws2.Cells(▼, j).Interior.Color = RGB(●, ○, ◆)
End If

となっているはずです。(四角などの記号になっているのは「違いがある部分」)

ということは、これをFunctionまたはSubとして切り出せばいいです。戻り値は、このサブルーチン内で設定すれば不要なのでSubの方を選択しましょうか。Functionだと戻り値があるイメージなのであまり今回は向いていないです。(できなくはないが混乱のもとになりやすいため)

で、上記でいう◆とかの記号は「差分」なのでこれは引数で指定しましょうか。

投稿2022/05/10 01:37

BeatStar

総合スコア4958

matsudesuyo

2022/05/10 10:01

サブルーチンという方法があるのですね。知らないことなので、調べてやってみます。新しい手段を教えていただきありがとうございます。

BeatStar

2022/05/13 07:01

これは入門書(入門サイト)には必ずと言っていいほど載っていることなので入門書をざっと読んでみて自分がやりたい処理に近いものを探すのをお勧めしますよ。

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

ベストアンサー

シート及びセルのレイアウトが判らないので、こちらで動作確認はしていません。
以下で、どうでしょうか。

VBA
1
2    Dim str As Variant
3    str = Array("*ウ*", "*ケ*", "*ク*", "*市*", "*任*", "*ピ*", "*ジ*", "*本*", "*武*")
4    k = 58
5    For i = 11 To 57
6        For j = 3 To 33
7            For m = 58 To 60
8                With ws1
9                    For x = 0 To UBound(str)
10                        If .Cells(i, j) Like str(x) And .Cells(k + 3 * x, j).Value = "0" Then
11                            ws2.Cells(m + 3 * x, j).Interior.Color = RGB(255, 226, 121)
12                        End If
13                    Next
14                End With
15            Next m
16        Next j
17    Next i
18
19