Excel マクロ 重複チェックについて

質問

Excel マクロ 重複チェックについて

Sheet3のA列とB列に製品番号が入っています。
A列とB列を比較して、A列と同じ番号がB列に2個以上ある場合のみ
C列にフラグ「1]を入れたいです。

Sub RetsuCheck()
Dim i As Long
Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet3")

'「Sheet3」シートでA列とB列の重複をチェック。
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, "A") = ws1.Cells(i, "B") Then
ws1.Cells(i, "C") = 1
End If
Next i
End Sub

1個の場合には上記マクロで解決するのですが、

2個以上の場合にどうようなマクロを記載すればよいのか
アドバイスを頂けませんでしょうか。

よろしくお願いいたします。

回答No.1

myRange · ベストアンサー

方法はいくつかありますが、質問者のコードに近いものにするとして。。

Ａ列と同行のＣ列に、１をセットする場合。

'---------------------------------　
Sub test()
　Dim R As Long
　Dim WS As Worksheet
　Set WS = Worksheets("Sheet3")
　For R = 2 To WS.Cells(Rows.Count, "A").End(xlUp).Row
　　If WorksheetFunction.CountIf(WS.Range("B:B"), WS.Cells(R, "A")) > 1 Then
　　　　　WS.Cells(R, "C").Value = 1
　　End If
　Next R
End Sub
'------------------------------------

以上です。

お礼

早い回答助かりました。うまくできました。

回答No.2

tom04

こんばんは！
余計なお世話かもしれませんが・・・
関数でも対応できると思います。

C2セルに
=IF(COUNTIF(B:B,A2)>1,1,"")

としてオートフィルで下へずぃ～～～！っとコピーではどうでしょうか？

これをVBAでやるとすれば、
Sheet3のSheet見出し上で右クリック　→　コートの表示　→　白い画面に↓のコードをコピー＆ペーストしてみてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("B:B"), Cells(i, 1)) > 1 Then
Cells(i, 3) = 1
End If
Next i
End Sub

これでその都度マクロを実行しなくても数値を入力するたびにマクロが実行されるはずです。

以上、参考になれば良いのですが・・・m(__)m

お礼

関数での回答も記載して頂きありがとうございます。マクロでこのようなことができるのですね。勉強になりました。