mükerrer kayıt

[derwish]

arkadaşlar a1 firma ismi, a2 de fatura tarihi, a3 de fatura numarası var... daha önce kayıtlı tarih ve numaralı bir veri girdiğimde uyarı vermesini istiyorum..

aynı firma, tarih ve sayılı veri girdiğimde de... engellenmesini istiyorum...

yardımcı olursanız sevinirim.. teşekürler...

 

[Levent Menteşoğlu]

Aşağıdaki linki inceleyin.

http://www.excel.web.tr/viewtopic.php?p=30078&highlight=#30078

 

[derwish]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 Then
MsgBox "BU İSİM KAYITLIDIR"
Target.Clear
Target.Select
End If
End If
End Sub



anladığım kadarıyla bu aynı ismle farklı kayıt olmaması için... aynı firmaya ait birden çok fatura girişi yapıyorum... benim tam olarak istediğim aynı firma, aynı tarih ve sayılı fatura girişini önlemek... yani aynı faturayı birden çok girmemek için... aynı tarih ve sayılı başka firmaların faturası olabilir.... bu şekilde yaparsak onları giremeyiz..

bu koda tarih ve sayı koşulunuda eklemek istersek.... kod nasıl olmalı....

ilginiz için teşekkür ederim...

 

[Levent Menteşoğlu]

A sütununda Firma ismi,B sütununda fatura tarihi ve C sütunundada fatura no olduğunu kabul edersek, aşağıdaki şekilde deneyin. Eğer her üç kriterde bulunursa son yazılan bilgilerin yazı renginide kırmızı yapacaktır.

[vb:1:d2d65b717a]Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo 10
sonsat = Cells(65536, 1).End(xlUp).Row + 1
Range("A" & sonsat & ":C" & sonsat).Font.ColorIndex = 0
firma = Cells(sonsat - 1, 1).Value
tarih = Cells(sonsat - 1, 2).Value
no = Cells(sonsat - 1, 3).Value
If firma <> 0 And tarih <> 0 And no <> 0 Then
firmasay = Range("A1:A" & sonsat - 2).Find(firma).Row
tarihsay = Range("B1:B" & sonsat - 2).Find(tarih).Row
nosay = Range("C1:C" & sonsat - 2).Find(no).Row
If firmasay = tarihsay And firmasay = nosay Then
MsgBox "BU İSİM KAYITLIDIR"
sonsat = Cells(65536, 1).End(xlUp).Row
Range("A" & sonsat & ":C" & sonsat).Font.ColorIndex = 3
End If
End If
10 End Sub
[/vb:1:d2d65b717a]

 

[aligunes]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 Then
MsgBox "BU İSİM KAYITLIDIR"
Target.Clear
Target.Select
End If
End If
End Sub

a sutununa sicil girdiğimde "BU İSİM KAYITLIDIR" uyarısı alıyorum.
aynı uyarı altında B Sutunundaki ismi C Sutunundaki soy ismi ve D sutunundaki Ünvanı nasıl görebilirim tşk.iyi çalışmalar

 

[Levent Menteşoğlu]

MsgBox "BU İSİM KAYITLIDIR"

Yukarıdaki satırı aşağıdaki gibi değiştirerek deneyin.

MsgBox "BU İSİM KAYITLIDIR" & chr(10) & cells(target.row,2) & chr(10) & cells(target.row,3) & chr(10) & cells(target.row,4)

 

[aligunes]

sayın Leventm verdiğiniz kodu denedim çalışmadı.

 

[Levent Menteşoğlu]

Dosyanızı gönderirmisiniz.

 

[aligunes]

sayın leventm dosyayı ekte gönderiyorum

 

[Levent Menteşoğlu]

Kodu aşağıdaki ile değiştirerek deneyin.

[vb:1:5817adf153]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 Then
sat = Range("A1:A" & Target.Row - 1).Find(Target.Value).Row
MsgBox "BU İSİM KAYITLIDIR" & Chr(10) & Cells(sat, 2).Value & Chr(10) & Cells(sat, 3).Value & Chr(10) & Cells(sat, 4).Value
Target.Clear
Target.Select
End If
End If
End Sub[/vb:1:5817adf153]

 

[nihatkocaoglan]

sayın leventm, bu kodlar çalışıyor ama a sütununu komple sildigğimizde hata veriyor, nasıl düzeltebiliriz?
birde bu olayı yani mükerrer kaydı bir textbox için yapabilirmisiniz?
teşekkürler

 

[Levent Menteşoğlu]

A sütununu komple sildiğinizde hata vermesi normaldir, çünkü kod a sütunundaki dolu hücreleri esas alarak çalışmaktadır. Sizin talebinize göre yeniden düzenlenmesi gerekir.

birde bu olayı yani mükerrer kaydı bir textbox için yapabilirmisiniz?

Textbox için neden istediğinizi anlayamadım. Combobox olabilir mi? En iyisi bir dosya eklerseniz onun üzerinden gidelim.

 

[nihatkocaoglan]

sayın leventm ilginize teşekkür ederim, sanırım yapmak istediğimi biraz daha açıklarsam sorunumu yanıtlayabileceksiniz.

1. "Sizin talebinize göre yeniden düzenlenmesi gerekir" demişsiniz. a sütunu boş ve ben kayıt eklemeye başlıyorum, sorun yok ama duruma göre bütün kayıtları silmem gerekiyor hata! işte o bahsettiğiniz yeniden düzenleme nasıl olmalı mümkünse yazar mısınız?

2. neden combobox değil de textbox demişsiniz; combobox zaten bana mevcut kayıtları veren bir uygulama ben zaten mükerrer kayıttan şikayetçiyim veya aynı kaydı bir daha yapmayacağım bu nedenle textboxtan örn. bir isim giriyorum ve bu ismi a sütununa kaydetmesini sitiyorum ancak daha önce kayıtlı ise bana mesaj vermesini istiyorum. ben bunu find ile yapmaya çalıştım yani textboxa girdigim veriyi listede aradı buldu, eğer bulursa bana uyarı msg vermesini istemiştim ama hata verdi, bulamaz ise normal bir şekilde textboxı listeye ekleyecekti. bana find ile aranan değerin bulunup bulunmadığını nasıl koşula bağlayacağımı da anlatırsanız sevinirim.

şimdiden teşekkürler

 

[Levent Menteşoğlu]

Sorularınıza sırası ile cevap vermeye çalışayım.

1-Yukarıda verdiğim kodlarıda private sub.... un hemen altına "on error resume next" satırını ilave edin.

2-Textbox içinde ben sorunuzdan sanki textbox içinde listeleme yapıyormuşsunuz gibi anladığım için neden combobox değil diye sormuştum. Find komutu aradığı veriyi bulamadığında hata verecektir. Bu sebeple on error goto ... gibi bir satırla hata durumunda goto'dan sonra yazacağınız ifade ile ilgili satıra yönlendirilerek textboxtaki veri sayfaya ilave edilebilir. Bunun dışında başka alternatif yollar ilede sorunu çözmek mümkün, bu sebeple bir örnek dosya eklemenizde fayda görüyorum.

 

[nihatkocaoglan]

öncelikle hızınıza hayran oldum teşekkür ederim

vallahi yapacağım dosyaya kaydı textbox ile eklemeyi planlayıp, mükerrer olduğunda hata vermesini istediğim için ilk işim bunu denemek oldu dün onca saat uğraştıktan sonra bu işi çözemeyince dosyayı da sildim o nedenle ekleyemiyorum. ama şimdi önerileriniz doğrultusunda yeniden başlayacağım, bu kez sorun olursa dosyayıda eklerim.

tekrar teşekkür

 

[nihatkocaoglan]

sayın leventm sanırım bu şekilde kastettiniz ancak bu şekilde sürekli "BU İSİM KAYITLIDIR" mesajı feliyor ve kapanmıyor


Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Column = 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 Then
MsgBox "BU İSİM KAYITLIDIR"
Target.Clear
Target.Select
End If
End If
End Sub