複数のIF文を簡素化したい(VBA)

Question

実現したいこと

下記のようなIFが複数続く場合、配列などを使って簡素化することは可能でしょうか。
右と左の組み合わせでどちらか一方が未入力であればメッセージボックスが出てくるようにしているつもりです。ご教示いただけると幸いです。

発生している問題・分からないこと

もっと簡単なプログラムを作りたいです。

該当のソースコード

Sub sample33()

    Dim row_c1 As Long
    Dim row_c2 As Long
    Dim wb As Workbook
    Dim wb_out As Workbook
    Dim ws As Worksheet
    Dim ws_out As Worksheet

    Set wb = Workbooks("Xブック.xlsx")
    Set wb_out = Workbooks("Yブック.xlsm")
    Set ws = wb.Worksheets("Xシート")   'データ元
    Set ws_out = wb_out.Worksheets("Yシート") '出力先
    
    row_c1 = 3
    row_c2 = 10
    
            Do While CStr(ws.Cells(row_c1, "A").Value) <> "END"
       
               'XシートのD(右)とE(左)のいずれかが未入力
                     If CStr(ws.Cells(row_c1, "D").Value) = "" Or CStr(ws.Cells(row_c1, "E").Value) = "" Then
                        MsgBox "Xシート," & row_c1 & "行目は画像名称が未入力です"
                        row_c2 = row_c2 + 1
                     End If

                         'XシートのF(右)とG(左)のいずれかが未入力
                         If CStr(ws.Cells(row_c1, "F").Value) = "" Or CStr(ws.Cells(row_c1, "G").Value) = "" Then
                             MsgBox "Xシート," & row_c1 & "行目は画像名称が未入力です"
                             row_c2 = row_c2 + 1
                         End If

		　　　　　　'XシートのH(右)とI(左)のいずれかが未入力
                         　　If CStr(ws.Cells(row_c1, "H").Value) = "" Or CStr(ws.Cells(row_c1, "I").Value) = "" Then
                             　MsgBox "Xシート," & row_c1 & "行目は画像名称が未入力です"
                             　row_c2 = row_c2 + 1
                        　　　End If

                  row_c1 = row_c1 + 1
                      
             Loop

End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

For Each RGT In Array(D,F,H)
For Each RGT In Array(E,G,I)
For文に入れると内側と外側のずれが生じるので上手く行きませんでした。

補足

特になし

Comments

[tatsu99]

不明点です。
１．row_c2 をメッセージボックスを表示するたびに、加算していますが、そのあと、row_c2 を使用していません。加算は不要かと思いますが、いかがでしょうか。

２．1つの行で、D,Eの何れかが未入力、F,Gの何れかが未入力、H,Iの何れかが未入力の場合、３回エラーメッセージが表示されますが、これは、意図した動作でしょうか。１回だけ表示すれば良いかと思うのですが、いかがでしょうか。

Answer 1

列を"D"のような文字列じゃなくて4のような数値で指定すれば良いのではないでしょうか。

For col = 4 To 8 Step 2
  If CStr(ws.Cells(row_c1, col).Value) = "" Or CStr(ws.Cells(row_c1, col+1).Value) = "" Then
     MsgBox "Xシート," & row_c1 & "行目は画像名称が未入力です"
     row_c2 = row_c2 + 1
  End If
Next

Answer 2

if文のフォーマットが同一、if文の中の処理が同一前提ですが
サブプロシージャ化して外に出してみるのはどうでしょう。

Sub Codetest033()

    Dim row_c1 As Long
    Dim row_c2 As Long
    Dim wb As Workbook
    Dim wb_out As Workbook
    Dim ws As Worksheet
    Dim ws_out As Worksheet

    Set wb = Workbooks("Xブック.xlsx")
    Set wb_out = Workbooks("Yブック.xlsm")
    Set ws = wb.Worksheets("Xシート")   'データ元
    Set ws_out = wb_out.Worksheets("Yシート") '出力先
    
    row_c1 = 3
    row_c2 = 10

             Do While CStr(ws.Cells(row_c1, "A").Value) <> "END"
       
                    Call Codetest033sub("D", "E", ws, row_c1, row_c2)

                    Call Codetest033sub("F", "G", ws, row_c1, row_c2)

                    Call Codetest033sub("H", "I", ws, row_c1, row_c2)

                  row_c1 = row_c1 + 1
                      
             Loop

End Sub
Sub Codetest033sub(arg列1 As String, arg列2 As String, argws As Worksheet, argrow_c1 As Long, argrow_c2 As Long)

               'Xシートの列1(右)と列2(左)のいずれかが未入力
                     If CStr(argws.Cells(argrow_c1, arg列1).Value) = "" Or CStr(argws.Cells(argrow_c1, arg列2).Value) = "" Then
                        MsgBox "Xシート," & argrow_c1 & "行目は画像名称が未入力です"
                        argrow_c2 = argrow_c2 + 1
                     End If

End Sub

Answer 3

外出ししてみるとか。

Function BlankCheck(c As Range) As Boolean
    BlankCheck = CStr(c.Value) = "" Or CStr(c.Offset(, 1).Value) = ""
    If BlankCheck = True Then
        MsgBox c.Worksheet.Name & "," & c.Row & "行目は画像名称が未入力です"
    End If
End Function

Answer 4

配列などを使って簡素化することは可能でしょうか。

ロジックは、既存の回答と重複していますが、
参考までに、配列を使った例です。

Sub sample33()

  Dim row_c1 As Long
  Dim row_c2 As Long
  Dim wb As Workbook
  Dim wb_out As Workbook
  Dim ws As Worksheet
  Dim ws_out As Worksheet

  Set wb = Workbooks("Xブック.xlsx")
  Set wb_out = Workbooks("Yブック.xlsm")
  Set ws = wb.Worksheets("Xシート")   'データ元
  Set ws_out = wb_out.Worksheets("Yシート") '出力先

  Dim lastRow As Long
  lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  Dim values As Variant
  values = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 9)).Value

  row_c1 = 3
  row_c2 = 10
  Dim i As Long

  Do While CStr(values(row_c1, 1)) <> "END"
    For i = 4 To 8 Step 2
      If IsEmpty(values(row_c1, i)) Or IsEmpty(values(row_c1, i + 1)) Then
        MsgBox "Xシート," & row_c1 & "行目は画像名称が未入力です"
        row_c2 = row_c2 + 1
      End If
    Next i 

    row_c1 = row_c1 + 1
                      
  Loop

End Sub

配列の使い方が違いますが、こんなことも...という例です。

Sub sample33()

  Dim row_c1 As Long
  Dim row_c2 As Long
  Dim wb As Workbook
  Dim wb_out As Workbook
  Dim ws As Worksheet
  Dim ws_out As Worksheet

  Set wb = Workbooks("Xブック.xlsx")
  Set wb_out = Workbooks("Yブック.xlsm")
  Set ws = wb.Worksheets("Xシート")   'データ元
  Set ws_out = wb_out.Worksheets("Yシート") '出力先

  row_c1 = 3
  row_c2 = 10
  
  Dim col As Variant
  col = [{"D", "E"; "F", "G"; "H", "I"}]
  Dim i As Long

  Do While CStr(ws.Cells(row_c1, "A").Value) <> "END"
    For i = 1 To UBound(col, 1)
      If IsEmpty(ws.Cells(row_c1, col(i, 1))) Or IsEmpty(ws.Cells(row_c1, col(i, 2))) Then
        MsgBox "Xシート," & row_c1 & "行目は画像名称が未入力です"
        row_c2 = row_c2 + 1
      End If
    Next i

    row_c1 = row_c1 + 1
                      
  Loop

End Sub

上をFor Eachを使う方法に変更すると、

Sub sample33()

  Dim row_c1 As Long
  Dim row_c2 As Long
  Dim wb As Workbook
  Dim wb_out As Workbook
  Dim ws As Worksheet
  Dim ws_out As Worksheet

  Set wb = Workbooks("Xブック.xlsx")
  Set wb_out = Workbooks("Yブック.xlsm")
  Set ws = wb.Worksheets("Xシート")   'データ元
  Set ws_out = wb_out.Worksheets("Yシート") '出力先

  row_c1 = 3
  row_c2 = 10
  
  Dim col As Variant
  col = [{"D", "F", "H"}]
  Dim v As Variant
  Dim rng As Range

  Do While CStr(ws.Cells(row_c1, "A").Value) <> "END"
    For Each v In col
      Set rng = ws.Range(v & row_c1)
      If IsEmpty(rng) Or IsEmpty(rng.Offset(0, 1)) Then
        MsgBox "Xシート," & row_c1 & "行目は画像名称が未入力です"
        row_c2 = row_c2 + 1
      End If
    Next v

    row_c1 = row_c1 + 1
                      
  Loop

End Sub