シート間のマッチング
これは、2つのExcelシートの間でデータを照合し、一致するものに印をつけ、一致しないものに色をつける処理を行うエクセルマクロです。
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 LastCol1 As Long
LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
'相手_アクティブシートの右のシート
Dim wb2 As Workbook
Set wb2 = ThisWorkbook
Dim ws2 As Worksheet
Set ws2 = wb2.ActiveSheet.Next
Dim LastCol2 As Long
LastCol2 = ws2.Cells(2, Columns.Count).End(xlToLeft).Column
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 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
For Key2 = 2 To LastRow2
For key1 = 2 To LastRow1
If ws1.Cells(key1, 1).Value = ws2.Cells(Key2, 1).Value Then
ws1.Cells(key1, 7).Value = "OK"
Exit For
End If
Next
Next
For key1 = 2 To LastRow1
If ws1.Cells(key1, 1).Value = "" Then
ws1.Cells(key1, 1).Interior.Color = 65535
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "完了"
End Sub
解説
- まず、Withステートメントを使用して、スクリーン更新、イベント、警告、計算を停止するようにExcelアプリケーションの設定を変更しています。これにより、マクロ実行中に画面がちらつかず、処理が高速になります。
- 次に、基本となるアクティブシートと、基本シートの右側にある相手のアクティブシートを取得しています。これにより、基本シートと相手シートの間でデータを照合することができます。
- それぞれのシートから、最終列と最終行を取得しています。これにより、マクロが処理するデータの範囲を指定することができます。
- 2つのForループを使用して、基本シートの各行と相手シートの各行を順番に比較していきます。もし2つのセルの値が一致した場合は、基本シートの7列目に”OK”という文字列を入力し、ループを終了します。
- 次に、基本シートの各行を順番に比較して、空の場合はセルの色を変えています。
- 最後に、Withステートメントを使用してExcelアプリケーションの設定を元に戻し、処理の完了を通知するメッセージボックスを表示しています。
コメント