シート間の差分を出すやつ
先日Excelを購入したこともあり、vbaを最近使用している。
シート間の差分を出すコードを書いてみた。差分があった行をマーキングするようにした。
※コードの中には、途中経過を把握するためにイミディエイトウィンドウに表示する情報もそのまま残している。
Option Explicit Sub sample() Application.ScreenUpdating = False Dim num As Long num = Cells(Rows.Count, 2).End(xlUp).Row Dim i As Integer i = 0 Dim j As Integer j = 0 Dim k As Integer k = 0 Dim m As Variant m = 0 i = 8 j = 3 k = 4 Dim ans As Variant ans = 0 Dim arr() As Variant ReDim arr(100) Dim l As Integer l = 0 For i = 8 To 12 With ActiveSheet Debug.Print i - 7 Debug.Print "-----" For k = 4 To 10 On Error GoTo Err_Label m = WorksheetFunction.Match(Cells(i, j), Worksheets(.Previous.Name).Cells(3, 3).EntireColumn, 0) ans = WorksheetFunction.Index(Worksheets(.Previous.Name).Range("$A$1:$Z$20"), m, k) arr(k - 4) = WorksheetFunction.CountIf(Worksheets(.Previous.Name).Cells(m, k), Cells(m, k)) If arr(k - 4) >= 1 Then l = l + 1 ElseIf arr(k - 4) = 0 Then ' End If Debug.Print ans Debug.Print "arr:" & arr(k - 4) Debug.Print "wwww" Next Debug.Print "-----" If l = 7 Then Debug.Print "完全一致" l = 0 Else For k = 4 To 11 Cells(i, k - 1).Interior.Color = RGB(255, 255, 0) Debug.Print "新規" Next l = 0 End If End With Next Exit Sub Err_Label: MsgBox "見つかりませんでした。エラーコードは次の通りです。" & Err.Number & "," & Err.Description On Error GoTo 0 Resume Next End Sub