iki sütunda mükerrer kayıt kontrolü

[Kenan Yaz]

İyi akşamlar. Ekteki dosyamda iki sütunda mükerrer kayıt kontrolü yaptırmak istiyorum. Ancak ne yazarsam yazayım bu kayıt girilmiş uyarısı ile karşılaşıyorum. Kodlarda yardımcı olursanız sevinirim. Mükerrer kayıt uyarısının, her iki sütundaki veriler eşleşince gerçekleşmesi halinde verilmesi gerekir.Teşekkürler.

 

[Ömer]

Merhaba,

If Not k Is Nothing Or Not n Is Nothing Then

Or yerine And yazarak deneyiniz..

.

 

[Kenan Yaz]

Ömer bey "and" olarak dosyayı güncelledim. Dosyaya da not aldım. bazı veriler iki sütunda da farklı olduğu halde yazdıramadım. Bir bakarsınız sevinirim. iyi geceler.Dosya 1. mesajda güncellendi.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Private Sub CommandButton1_Click()
Dim son, sira As Long
Dim sat, deg, s As Integer
Dim k, n As Range
[B][COLOR=red]Dim Adres As String[/COLOR][/B]
[B][COLOR=red]Dim VarYok As Boolean[/COLOR][/B]
'mükerrer kontrol
'Set k = Range("B:B").Find(ComboBox3.Text, , xlValues, xlWhole)
'Set n = Range("c:c").Find(TextBox2.Text, , xlValues, xlWhole)
[B][COLOR=red]VarYok = False[/COLOR][/B]
[B][COLOR=red]With Range("B:B")[/COLOR][/B]
[B][COLOR=red]   Set k = .Find(ComboBox3.Text, LookIn:=xlValues, LookAt:=xlWhole)[/COLOR][/B]
[B][COLOR=red]   If Not k Is Nothing Then[/COLOR][/B]
[B][COLOR=red]       Adres = k.Address[/COLOR][/B]
[B][COLOR=red]       Do[/COLOR][/B]
[B][COLOR=red]           If Cells(k.Row, "C") = TextBox2.Text Then VarYok = True[/COLOR][/B]
[B][COLOR=red]           Set k = .FindNext(k)[/COLOR][/B]
[B][COLOR=red]       Loop While Not k Is Nothing And k.Address <> Adres And VarYok = False[/COLOR][/B]
[B][COLOR=red]   End If[/COLOR][/B]
[B][COLOR=red]End With[/COLOR][/B]
[B][COLOR=red]If VarYok = True Then[/COLOR][/B]
[B][COLOR=red] MsgBox "Bu Kayıt Daha Önce Girilmiş", vbInformation, "MEVCUT KAYIT UYARISI"[/COLOR][/B]
[B][COLOR=red] Exit Sub[/COLOR][/B]
End If
'For sat = 3 To Cells(65536, "C").End(xlUp).Row
'If Cells(sat, "C") = TextBox2 Then
'MsgBox "Bu Kayıt Daha Önce Girilmiş", vbInformation, "MEVCUT KAYIT UYARISI"
'TextBox2 = Empty: TextBox2.SetFocus
'Exit Sub: End If: Next
For sat = 3 To Cells(65536, "B").End(xlUp).Row
Next
 
Cells(sat, "B") = ComboBox3 * 1
Cells(sat, "C") = TextBox2 * 1
Cells(sat, "D") = TextBox3
Cells(sat, "E") = TextBox4
Cells(sat, "F") = TextBox5
Cells(sat, "G") = TextBox6
Cells(sat, "H") = TextBox7
Cells(sat, "I") = TextBox8
Cells(sat, "J") = TextBox9
Cells(sat, "K") = TextBox10
Cells(sat, "L") = TextBox11
Cells(sat, "M") = TextBox12
Cells(sat, "N") = TextBox13
Cells(sat, "O") = TextBox14
Cells(sat, "P") = TextBox15
Cells(sat, "Q") = TextBox16
Cells(sat, "R") = TextBox17
If TextBox30 = "" Then
Cells(sat, "S") = ""
Else
Cells(sat, "S") = CDate(TextBox30.Value)
End If
s = s + 1
 
For sira = 3 To Cells(65536, "B").End(xlUp).Row
ActiveSheet.Cells(sira, "A") = Format(sira - 2, "000")
Next
Call temiz
End Sub

 

[Kenan Yaz]

Sayın Yeşertener, verdiğiniz kodlarla dosyayı güncellledim. Ancak bazı verileri mükerrer olduğu halde kaydediyor. Mükerrer kayıtlar dosyada belirtildi. Dosyaya -son olmak üzere- bir kez daha bakabilirseniz sevinirim. Emekleriniz için teşekkürler. İyi çalışmalar. ***Dosya 1. mesajda güncellendi

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub CommandButton1_Click()
Dim son, sira As Long
Dim sat, deg, s As Integer
Dim k, n As Range
Dim Adres As String
Dim VarYok As Boolean

VarYok = False

[COLOR=Red][B]son = [b65536].End(3).Row
sonuc = Evaluate(Replace("SUMPRODUCT((B3:B65536=" & ComboBox3 & ")*(C3:c65536=" & TextBox2 & "))", 65536, son))
[/B][/COLOR]
[COLOR=Red][B]If sonuc > 0 Then VarYok = True[/B][/COLOR]

If VarYok = True Then
  MsgBox "Bu Kayıt Daha Önce Girilmiş", vbInformation, "MEVCUT KAYIT UYARISI"
  Exit Sub
End If

For sat = 3 To Cells(65536, "B").End(xlUp).Row
Next
Cells(sat, "B") = ComboBox3 * 1
Cells(sat, "C") = TextBox2 * 1
Cells(sat, "D") = TextBox3
Cells(sat, "E") = TextBox4
Cells(sat, "F") = TextBox5
Cells(sat, "G") = TextBox6
Cells(sat, "H") = TextBox7
Cells(sat, "I") = TextBox8
Cells(sat, "J") = TextBox9
Cells(sat, "K") = TextBox10
Cells(sat, "L") = TextBox11
Cells(sat, "M") = TextBox12
Cells(sat, "N") = TextBox13
Cells(sat, "O") = TextBox14
Cells(sat, "P") = TextBox15
Cells(sat, "Q") = TextBox16
Cells(sat, "R") = TextBox17
If TextBox30 = "" Then
Cells(sat, "S") = ""
Else
Cells(sat, "S") = CDate(TextBox30.Value)
End If
s = s + 1
 
For sira = 3 To Cells(65536, "B").End(xlUp).Row
ActiveSheet.Cells(sira, "A") = Format(sira - 2, "000")
Next
Call temiz
End Sub

 

[Necdet]

Merhaba,

Mesajımdaki

Loop While Not k Is Nothing And k.Address <> Adres And VarYok = True

satırında True False olmalıydı. onu düzelttim.

Ama Levent Beyin kullandığı EVALUATE ve SUMPRODUCT kullanımı daha kısa ve anlaşılır, onu kullanmanızı öneririm.

 

[Kenan Yaz]

Üstadlarım cevaplarınız için teşekkür ederim. Sizleri yorduk kusurumuzu hoşgörün. İyi çalışmalar.