C,D,E sütunlarına göre mükerrer kayıt kontrolü

[Korhan Ayhan]

Selamlar,

Sn. leventm konuyla ilgili yardımınızı bekliyorum. :hey:

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:9af76e0193]On Error Resume Next
Application.ScreenUpdating = False
Set s1 = Sheets("s1")
bul = 1
ara = TextBox4.Value
say = WorksheetFunction.CountIf(s1.[d2:d65536], ara)
If IsNumeric(ara) = True Then ara = TextBox4 * 1
If say > 0 Then
For b = 1 To say
adr = "d" & bul + 1 & ":d65536"
bul = WorksheetFunction.Match(ara, s1.Range(adr), 0) + bul
ara1 = s1.Cells(bul, "c")
ara2 = s1.Cells(bul, "e")
deg = ComboBox1
If IsNumeric(ComboBox1) = True Then deg = ComboBox1 * 1
If ara1 = CDate((TextBox1 & "." & TextBox2 & "." & TextBox3)) And ara2 = deg Then
ListBox1.ListIndex = bul + 2
Exit Sub
End If
Next
End If
.
.
.
[/vb:1:9af76e0193]

 

[Korhan Ayhan]

Selamlar,

Koddaki bu bölümü değiştirince istediğim gibi çalıştı çok teşekkür ederim. :arkadas:

ListBox1.ListIndex = bul - 2

 

[Korhan Ayhan]

Selamlar,

Sn. leventm yukarıdaki koda eğer veri alanı boşsa veya veri bulunamazsa uyarı mesajı vermesi prosedürünü ekleyebilirmiyiz.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:4d8e886bcc]On Error goto 10
Application.ScreenUpdating = False
Set s1 = Sheets("s1")
bul = 1
ara = TextBox4.Value
say = WorksheetFunction.CountIf(s1.[d2:d65536], ara)
If IsNumeric(ara) = True Then ara = TextBox4 * 1
If say > 0 Then
For b = 1 To say
adr = "d" & bul + 1 & ":d65536"
bul = WorksheetFunction.Match(ara, s1.Range(adr), 0) + bul
ara1 = s1.Cells(bul, "c")
ara2 = s1.Cells(bul, "e")
deg = ComboBox1
If IsNumeric(ComboBox1) = True Then deg = ComboBox1 * 1
If ara1 = CDate((TextBox1 & "." & TextBox2 & "." & TextBox3)) And ara2 = deg Then
ListBox1.ListIndex = bul + 2
Exit Sub
End If
Next
End If
.
.
.
exit sub
10 msgbox "VERİ BULUNAMADI"
[/vb:1:4d8e886bcc]