例文を使って繰り返し業務を時短

【マクロ・VBA】縦(行)ループしてシート内の異なる表を比較して一致させる

エクセル、マクロ、VBAでループして同一シート内の2つの表を比較して一致させる VBA

シート内のマッチング

これは、アクティブなシート内のデータについて、2つの列を比較し、一致する場合には1つ目の列に「OK」という文字列を挿入し、一致しない場合には1つ目の列の背景色を変更するエクセルマクロです。

Sub シート内マッチング()

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With

'基_アクティブシート
Dim wb1 As Workbook
    Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
    Set ws1 = wb1.ActiveSheet

Dim key1 As Long
Dim LastRow1 As Long
    LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim Key2 As Long
Dim LastRow2 As Long
    LastRow2 = ws1.Cells(Rows.Count, 13).End(xlUp).Row

For Key2 = 2 To LastRow2
    For key1 = 2 To LastRow1
    
        If Cells(key1, 1).Value = Cells(Key2, 13).Value Then
           Cells(key1, 7).Value = "OK"
        Exit For
        End If
    
    Next
Next

For key1 = 2 To LastRow1
    
        If Cells(key1, 7).Value = "" Then
            Cells(key1, 1).Interior.Color = 65535
        End If
    
Next

' ws2.Range("B" & migi).Value

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With

MsgBox "完了"
End Sub

解説

  • まず、アプリケーションの設定が変更され、画面更新や自動計算、イベント処理が無効化されます。これにより、マクロの実行が高速化されます。
  • 次に、2つのForループがあり、それぞれキーとなる行の範囲を定義します。最初のForループは、13列目のデータを順に取得し、2番目のForループは、1列目のデータを順に取得します。そして、一致するデータが見つかった場合には、1番目の列の7番目のセルに「OK」という文字列を挿入してループを終了します。
  • その後、2番目のForループが実行され、7番目のセルに何も挿入されていない場合には、1番目の列の背景色が黄色に変わります。
  • 最後に、アプリケーションの設定が元に戻され、完了メッセージが表示されます。

コメント

タイトルとURLをコピーしました