• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Mükerrer Veri Girişine UYARI Verdirme

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For a = [N65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("N3:N" & a), Cells(a, "N")) > 1 Then Rows(a).ClearContents
Next
End Sub

Yukarıda ki Makro Koduna
MsgBox "Mükerrer Kayıt Girişi Yaptınız" uyarısını nasıl verdirebilirim?
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For a = [N65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("N3:N" & a), Cells(a, "N")) > 1 Then Rows(a).ClearContents
Next
End Sub

Yukarıda ki Makro Koduna
MsgBox "Mükerrer Kayıt Girişi Yaptınız" uyarısını nasıl verdirebilirim?

buna eklemek isterseniz

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For a = [N65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("N3:N" & a), Cells(a, "N")) > 1 Then Rows(a).ClearContents
Next
MsgBox "Mükerrer Kayıt Girişi Yaptınız" 
End Sub

ile
dilerseniz bir başka kod ise
Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("N1:N65536")) Is Nothing Or Target = "" Then Exit Sub
For x = 1 To Sheets.Count
Say = WorksheetFunction.CountIf(Sheets(x).Range("N1:N65536"), Target)
knt = knt + Say
Next
If knt > 1 Then
MsgBox "Bu veri daha önce girilmiş.", vbCritical, "UYARI"
Target = ""
End If
End Sub
çalışma sayfanızın Thisworkbook sayfasına yapıştırınız.
son koda örnek dosya ekledim deneyiniz.
 

Ekli dosyalar

rica ederim iyi çalışmalar
 
Geri
Üst