A,B,C Sütununlarındaki değer aynı ise

[Tarikkk_]

Merhabalar 4. satırdan son satıra A,B,C Sütunlarında değer aynı ise hata mesajı almak istiyorum. fakat bir türlü yapamadım nerde hata yaptığımı anlamadım yardımlarınızı bekliyorum şimdiden teşekkürler.

Private Sub Worksheet_Change(ByVal Target As Range)

    SonSatır = ActiveSheet.Cells(65000, "B").End(3).Row
For Satır = 4 To SonSatır

If WorksheetFunction.CountIfs(Range("B4:B100"), Cells(Satır, "B"), _
Range("C4:C100"), Cells(Satır, "C"), _
Range("D4:D100"), Cells(Satır, "D")) > 1 Then
BilgiMesajı ("GİRMİŞ OLDUĞUNUZ KAYIT MEVCUT..!!")
ActiveCell = ""
Exit For
End If
Next Satır

End Sub

 

[YUSUF44]

Cepten baktığımdan deneyemiyorum ancak bu kontrol için döngü kullanmanıza gerek yok. Aşağıdaki gibi de olur:

Private Sub Worksheet_Change(ByVal Target As Range)
If intersect(Target, [A4100]) is nothing Then exit sub
Sat= ActiveCell.Row
If WorksheetFunction.CountIfs(Range("B4:B100"), Cells(Sat, "B"), _
Range("C4:C100"), Cells(Sat, "C"), _
Range("D4100"), Cells(Sat, "D")) > 1 Then
Msgbox "GİRMİŞ OLDUĞUNUZ KAYIT MEVCUT..!!", vbinformation
Target = ""
End If
End Sub

Not: sorun "Msgbox" yerine "bilgimesajı" kullanmanızdan kaynaklanmış olabilir.

Bir de intersect satırını kullanıp Target belirlemezseniz sayfadaki alakasız hücrelerdeki değişikliklerde de makro çalışır.