mükerrer kayıt ta kod düzenleme

[ahsunay]

çalışma sayfasının kod bölümünde mükerrer kayıtlara izin vermeyen bir kod var bunu v sütününa göre düzenleyebilirmiyiz....teşekkür ederim

 

[fedeal]

dosyanız ekte,

 

[ahsunay]

teşekkür ederim.elinize sağlık

 

[ahsunay]

hocam hata veriyor..girişi sileyim mi diyor evet te desem hayır da desem ..aynı soruyu sürekli tekrarlıyor...

 

[fedeal]

ne gibi bir hata? sütuna yeni liste girdinizmi? eger girdiyseniz mükerrer kayıt bitene kadar verecektir.

 

[ahsunay]

şöyle hocam..daha önce sadece bir kere girdiğim bir kayıt giriyorum..daha önce girildiğine dair uyarı veriyor devam edeyim mi diye soruyor..evet te desem hayır da desem...devam etmiyor.....sürekli aynı şeyi soruyor

 

[ersoyalan]

Merhaba,

İstediğiniz böyle birşeymi?.Veri doğrulama ile yapılmıştır.

 

[ahsunay]

Hocam çok özür dilerim..bundan önce göndermiş olduğunuz örnek çok iyiydi..sadece uyarı sorusuna evette desem hayır da desem ..devam etmiyordu...o sorunu çözebilrseniz çok sevinirim...çok çok teşekkür ederim.zahmet veriyorum

 

[fedeal]

Hocam çok özür dilerim..bundan önce göndermiş olduğunuz örnek çok iyiydi..sadece uyarı sorusuna evette desem hayır da desem ..devam etmiyordu...o sorunu çözebilrseniz çok sevinirim...çok çok teşekkür ederim.zahmet veriyorum

Kodlardaki hatayı arıyorum inanın bulamuyorum çünkü ben o hatayı almıyorum.kodlarda oynama yapmadıysanız tekrar indirip denermisiniz.

 

[ahsunay]

teşekkür ederim hocam..çok ta önemli değil..yardımlarınız için teşekkür ederim..çok sağolun

 

[fedeal]

Private Sub Worksheet_Change(ByVal Target As Range)
a = [v65536].End(3).Row
If ActiveCell.Value = "" Then
ActiveCell.Interior.ColorIndex = xlNone
i = [v65536].End(3).Row + 1
Cells(i, 22).Interior.ColorIndex = xlNone
End If
If WorksheetFunction.CountIf(Range("v1:v" & a), Cells(a, "v")) > 1 Then
Cells(a, "v").Interior.ColorIndex = 6
On Error Resume Next
i = [v65536].End(3).Row
t = WorksheetFunction.Match(Cells(i, 22).Value, Range("v1:v" & i - 1), 0)
Cells(t, "v").Interior.ColorIndex = 6
MsgBox "bu kayıt " & t & " nolu satırda daha önce işlendi.."
cvp = MsgBox("girişi sileyimmi ?", vbYesNo, " FEDEAL ")
If cvp = vbNo Then
Else
Cells(a, "v").Value = ""
Cells(a, "v").Interior.ColorIndex = xlNone
GoTo fdl
End If
Else
Cells(a, "v").Interior.ColorIndex = xlNone
End If
fdl:
End Sub

mükerrer girişi sadece son girilen hücreye göre kontrol eder silinmesine hayır derseniz bir daha kontrol etmez.belki bu şekilde işinize yarar deneyin.