Sub TEST1()
'Sheet1のデータを比較シートに転記
With Sheets("Sheet1").Range("A1").CurrentRegion.Offset(1, 0)
.Resize(.Rows.Count - 1).Copy Sheets("比較").Range("A2")
End With
Dim Flag
Flag = 0
'Sheet2のデータをループ
For i = 2 To Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Flag = 0
'比較シートをループ
For j = 2 To Sheets("比較").Cells(Rows.Count, "A").End(xlUp).Row
'商品が一致する行を検索
If Sheets("比較").Cells(j, "A") = Sheets("Sheet2").Cells(i, "A") Then
Sheets("比較").Cells(j, "D") = Sheets("Sheet2").Cells(i, "A") '商品
Sheets("比較").Cells(j, "E") = Sheets("Sheet2").Cells(i, "B") '価格
Sheets("比較").Cells(j, "F") = Sheets("Sheet2").Cells(i, "C") '売上
Flag = 1 '一致する商品がある場合
Exit For
End If
Next
'一致する商品がない場合
If Flag = 0 Then
'最終行の1行下に値を入力
With Sheets("比較").Range("A1").CurrentRegion
.Cells(.Rows.Count + 1, 4) = Sheets("Sheet2").Cells(i, "A") '商品
.Cells(.Rows.Count + 1, 5) = Sheets("Sheet2").Cells(i, "B") '価格
.Cells(.Rows.Count + 1, 6) = Sheets("Sheet2").Cells(i, "C") '個数
End With
End If
Next
End Sub
では、ポイント毎に実行して、手順をみてみます。
Sheet1の値を、比較シートに転記をします。
Sheet1の値を比較シートに転記
次は、比較シートとSheet2の値を比較していきます。
比較シートとSheet2の値を比較していく
比較シートの値と、Sheet2の値を比較していきます。
一致する値がある場合は、同じ行に転記をします。
一致する値がない場合は、最終行+1行目に転記をします。
同じように、一致する値がない場合は、最終行+1行目に転記をします。
一致する値がある場合は、同じ行に転記をします。
一致する値がある場合は、同じ行に転記をします。
これで、2つのシートを比較できます。
2つのシートを比較できた
2つのシートを比較できました。
不一致を塗りつぶし
次は、商品のデータが一致する行で、「価格」と「数量」の不一致を塗りつぶしをしていきます。
不一致の値は塗りつぶし
商品のデータが一致する行で、不一致の確認をするVBAコードになります。
Sub TEST2()
Dim A
With Sheets("比較").Range("A1").CurrentRegion
'価格と売上をループ
For Each A In .Resize(.Rows.Count - 1, 2).Offset(1, 1)
'不一致の場合
If A <> A.Offset(0, 3) Then
'空白ではない場合
If A <> "" And A.Offset(0, 3) <> "" Then
A.Interior.Color = RGB(255, 255, 0) '塗りつぶし
A.Offset(0, 3).Interior.Color = RGB(255, 255, 0) '塗りつぶし
End If
End If
Next
End With
End Sub
Sub TEST3()
Dim A
'テーブルの価格と売上をループ
For Each A In Range("テーブル1_2").Resize(, 2).Offset(0, 1)
'不一致の場合
If A <> A.Offset(0, 3) Then
'空欄ではない場合
If A <> "" And A.Offset(0, 3) <> "" Then
A.Interior.Color = RGB(255, 255, 0) '塗りつぶし
A.Offset(0, 3).Interior.Color = RGB(255, 255, 0) '塗りつぶし
End If
End If
Next
End Sub