İki Kritere Göre Mükerrer Kayıt Sorgulama

[ahmedummu]

Merhaba arkadaşlar.

İki kritere göre mükerrer kayıt sorgulatabilir miyiz. örnek dosyada Ad ve Soyad'a göre mükerrer kayıt sorguluyor. Ad soyad ve T.C. Kimlik numarasına göre sorgulatabilir miyiz. Örnek dosyayı gönderdim. Yardımcı olursanız sevinirim.

 

[Asri]

CommandButton1_Click kodunu aşağıdaki şekilde değiştirip, deneyiniz.

Private Sub CommandButton1_Click()
If TextBox1.Value = "" Or TextBox2.Value = "" Then
MsgBox ("Ad soyad ve T.C. Kimlik Numarası bilgilerini giriniz."), vbCritical, "Uyarı"
Exit Sub
End If

[COLOR=red]Dim tcno As String[/COLOR]
[COLOR=red]Dim adi As String[/COLOR]
[COLOR=Red]
sonsatir = Cells(Rows.Count, "B").End(3).Row
For i = 2 To sonsatir
  adi = Cells(i, "B").Value
  tcno = Cells(i, "C").Value
  If adi = TextBox1 And tcno = TextBox2 Then
   MsgBox ("Adı : " & TextBox1.Value & Chr(10) & _
           "TC Kimlik No: " & TextBox2 & Chr(10) & _
           "Bu personel daha önce kaydedilmiş"), vbCritical, "Uyarı"
   Call temizle
   Exit Sub
  End If
Next i[/COLOR]

ListBox1.RowSource = ""

Sheets("sayfa1").Select
Range("b2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
 Loop
ActiveCell.Offset(0, 0).Value = TextBox1.Value
ActiveCell.Offset(0, 1).Value = TextBox2.Value
ActiveCell.Offset(0, 2).Value = TextBox3.Value
ActiveCell.Offset(0, 3).Value = TextBox4.Value
ActiveCell.Offset(0, 4).Value = TextBox5.Value
ActiveCell.Offset(0, 5).Value = Format(TextBox6.Value, "dd.mm.yyyy")
If OptionButton1.Value = True Then
ActiveCell.Offset(0, 6).Value = "BAY"
Else
ActiveCell.Offset(0, 6).Value = "BAYAN"
End If
If Not IsNumeric(ActiveCell.Offset(-1, -1)) Then
ActiveCell.Offset(0, -1).Value = 1
Else
ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(-1, -1).Value + 1
ActiveCell.Offset(0, -1).HorizontalAlignment = xlCenter
End If

Call temizle

With ListBox1
.ColumnCount = 7
.ColumnWidths = "80;60;50;50;50;50;30"
.RowSource = "b2:h" & Cells(Rows.Count, "b").End(xlUp).Row
End With

End Sub

 

[ahmedummu]

SAyın askm,

If Excel.WorksheetFunction.CountIfs([B:B], TextBox1, [C:C], TextBox2) > 0 Then

Yukarıdaki kod satırını seçip, resim görüntsünü gönderdiğim hatayı verdi.

 

[Asri]

SAyın askm,

If Excel.WorksheetFunction.CountIfs([B:B], TextBox1, [C:C], TextBox2) > 0 Then

Yukarıdaki kod satırını seçip, resim görüntsünü gönderdiğim hatayı verdi.

Mesaja dosya eklendi. Ancak sanırım sizde 2003 sürümü olduğu için bu fonksiyonu kullanamadınız.

 

[Asri]

Kod office 2003 e göre düzenlendi. Kontrol ediniz.

 

[ahmedummu]

Teşekkürler sayın askm. Güzel olmuş Elinize sağlık.

 

[askm]

Ahmet Bey teşekkürü yanlış kişiye yaptınız. Ben tatilde olduğum için kodlara bakamıyorum. Asri üstadım ilgilenmiş. Kendine adınıza teşekkür ediyorum.

 

[Asri]

Ahmet Bey teşekkürü yanlış kişiye yaptınız. Ben tatilde olduğum için kodlara bakamıyorum. Asri üstadım ilgilenmiş. Kendine adınıza teşekkür ediyorum.

Cümle olumlu olduğu için problem yok : )
Olumsuz olsaydı düzeltme yapardım.

 

[ahmedummu]

Teşekkürler, eksik olmayın.