行ずれ(上)チェック

Sub prcCheckValuesDynamicRangeAndSkipEmpty()
    ' 変数宣言
    Dim lngLastRow As Long         ' A列のデータ入力セル終端
    Dim lngRow As Long             ' 繰り返し処理で使用する行番号
    Dim arrCheckValues As Variant  ' チェック対象の値を格納する配列
    Dim bolFound As Boolean        ' 値が配列内に見つかったかを示すフラグ
    Dim ws As Worksheet            ' 処理対象のワークシート
    Dim i As Integer               ' ループカウンタ
    
    ' 処理対象のワークシートを設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' A列のデータ入力セル終端を取得
    lngLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' A列のセルをループしてチェック
    For lngRow = 1 To lngLastRow
        ' A列のセルが空白の場合、処理をスキップ
        If IsEmpty(ws.Cells(lngRow, 1).Value) Or ws.Cells(lngRow, 1).Value = "" Then
            GoTo NextIteration
        End If
        
        ' 対応する10セル分の範囲を配列に読み込む
        arrCheckValues = ws.Range(ws.Cells(lngRow, 2), ws.Cells(lngRow + 10, 2)).Value
        
        ' 初期化
        bolFound = False
        
        ' 配列内の値とセルの値を比較
        For i = 1 To UBound(arrCheckValues, 1)
            If ws.Cells(lngRow, 1).Value = arrCheckValues(i, 1) Then
                bolFound = True
                Exit For
            End If
        Next i
        
        ' 値が見つかった場合、C列に「要確認」と出力
        If bolFound Then
            ws.Cells(lngRow, 3).Value = "要確認"
        End If
        
NextIteration:
    Next lngRow
End Sub

コメント