ExcelVBA修正のお願い

・Excel(M365)で、添付ファイルが実行できるようなVBAを作成しましたが、おかしな点を修正していただけませんでしょうか。

＜具体的に実施したいこと＞
・①Sheet1のE列と、Sheet2のC列をマッチングし、Sheet1のJ列の値を、Sheet2のM列へ転記する。その際、Sheet1にデータ重複している場合（例：CCC,DDD）、そのデータの最下行の値を転記する（例：CCC→400、DDD→700）②この重複データについては、アラームのため、該当するSheet2のB~C列を赤くセル反転させる。
・上記マッチングしない場合は、Sheet2へは特に転記はしない（例：EEE）
・Sheet2については、11行目に項目があり、12行目以降へデータ転記したい。

↓以下の通り作成しましたが、「Sheet2については、11行目に項目があり、12行目以降へデータ転記したい。」「該当するSheet2のB~C列を赤くセル反転させる。」という部分をうまく反映できていないように感じていますが、どのように修正すればよいかを教えてください。。

Sub sample()
Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")
Dim i As Long, j As Long, r1 As Long, r2 As Long
Dim k As Long, cnt As Long
Dim ary

ws1.Select
With ws1
r1 = .Cells(Rows.Count, "E").End(xlUp).Row
ReDim ary(1 To r1, 1 To 2)
For i = 1 To r1
ary(i, 1) = .Cells(i, "E").Value
ary(i, 2) = .Cells(i, "J").Value
Next i
End With

With ws2
r2 = .Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To r2
cnt = 0
For j = 1 To UBound(ary, 1)
If .Cells(i, "C") = ary(j, 1) Then
k = j
cnt = cnt + 1
End If
Next j
If k > 0 Then
.Cells(i, "M").Value = ary(k, 2) '値段転記
If cnt > 1 Then .Cells(i, "M").Interior.ColorIndex = 3 '重複値赤
k = 0
End If
Next i
End With
End Sub

No.1 回答者： tatsumaru77 回答日時： 2024/07/03 07:49

うまくいってないというのは、具体的にどの箇所でしょうか。

①赤くセル反転する列を、B,C列にしたいが、M列が赤くなっている。
上記以外に、うまくいってない箇所はありますか？