veri girişinde tekrarı önleyen makro

[mekanikçi]

Private Sub Worksheet_Change(ByVal Target As Range)
Static veri()
Static Say As Integer
Dim Sorgu As String
If Target.Address = "$A$1" Then
Application.EnableEvents = False
On Error Resume Next
If IsError(Application.Match(Target.Value, veri, 0)) Then
On Error GoTo 0
Say = Say + 1
ReDim Preserve veri(1 To Say)
veri(Say) = Target.Value
Else:
Sorgu = MsgBox("Bu veriyi daha önce kullandınız." & vbCrLf & "Devam etmek istiyormusunuz?", vbCritical + vbYesNo, "Mükerrer Kayıt")
If Sorgu = vbNo Then Target.Value = Empty
End If
End If
Application.EnableEvents = True
End Sub



kırmızı olan yere tüm sütundaki hücreleri mi yazmam gerek.bu makroyu çalıştıramadım.firma ismi kaydı yaptığım sütuna aynı firmaları tekrar girmek istemiyorum .forumdan bir arkadaş bu makroyu gönderdi sağolsun ama ben makro konusunda acemiyim.bu soruna acil çözüm önerilerinizi bekliyorum arkadaşlar.

Not:çalışma kitabımda sayfa sayısı 1 den fazla.tüm sayfalrda B sütununda benzersiz veri girişi yapmam gerek.paylaşımlarınız için şimdiden teşekkürler

 

[leumruk]

Merhaba,
Örneği deneyiniz. Kodlar Thisworkbook bölümünde.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("b1:b65536")) Is Nothing Or Target = "" Then Exit Sub
For x = 1 To Sheets.Count
Say = WorksheetFunction.CountIf(Sheets(x).Range("b1:b65536"), Target)
knt = knt + Say
Next
If knt > 1 Then
MsgBox "Bu veri daha önce girilmiş.", vbCritical, "UYARI"
Target = ""
End If
End Sub

 

[mekanikçi]

bu kodu hem modül içine hemde kitap içine mi kopyalamam gerekiyor.
ayrıca emniyet olsun diye =EĞERSAY(B:B;B1)=1 FORMÜLÜNÜ girsek hem formül hemde makro aynı kolonu eş zamanlı kontrol ediyor mu?
modül kısmının tam olarak işlevi nedir.yani modül kısmı boş oluncada gönderdiğiniz makro çalıştı.modüllerle ilgilide bilgi verebilir misiniz?
verdiğiniz kod işe yaradı.teşekkürler.

 

[mekanikçi]

sayfa 3 e sayfa 1 ve 2 deki benzer verileri elle girince şu hata mesajını verdi sizn kod.
run time error '1004':
method 'intersect' of object'_Global 'failed

debug dan baktığımda şu satır sarı renkli olmuş***

If Intersect(Target, Range("b1:b65536")) Is Nothing Or Target = "" Then Exit Sub*****klavye ile benzer veri girişini yaptığımda yeni veri gibi kabul ediyor ve yukardaki mesajı veriyor.sebebi ne olabilir.

 

[leumruk]

sayfa 3 e sayfa 1 ve 2 deki benzer verileri elle girince şu hata mesajını verdi sizn kod.
run time error '1004':
method 'intersect' of object'_Global 'failed

debug dan baktığımda şu satır sarı renkli olmuş***

If Intersect(Target, Range("b1:b65536")) Is Nothing Or Target = "" Then Exit Sub*****klavye ile benzer veri girişini yaptığımda yeni veri gibi kabul ediyor ve yukardaki mesajı veriyor.sebebi ne olabilir.

Hata vermemsi lazım. Biryerlede hata yapmışsınızdır. Eklediğim dosyada bir sorun yok. Kendi dosyanıza uyguladığınızda mı sorun oldu? Unutmayın kod tek bir yerde olacak. Thisworkbook bölümünde.

 

[mekanikçi]

Hata vermemsi lazım. Biryerlede hata yapmışsınızdır. Eklediğim dosyada bir sorun yok. Kendi dosyanıza uyguladığınızda mı sorun oldu? Unutmayın kod tek bir yerde olacak. Thisworkbook bölümünde.

size dosyamı gönderiyorum.sayfa 1 deki girişler benden önce yapılmıştı.sayfa 2 yi ben yaptım.bunları tek sayfa yapacam ama sayfa 1 i incelerseniz iki satıra 1 şirket ismi girilmiş.sorun bundan olabilir mi