Mükerrer Kayıt kontrolünde birkaç kayıttan sonra doğru çalışıyor.Neden?

[ormancı421]

Arkadaşlar Bir tazminat proğramı hazırlıyorum. Ancak aşağıda Kaydet butonu Click i içerisindeki kod çalışırken ilk kayıtta sorun yok. Aynı kişiyi ikinci kez kayıt ederken Uyarı vermesi gerekirken, 3. yada 4. kez aynı kişi kaydında uyarı veriyor. Normalde aynı kişiyi 2.kez arka arkaya kayıt ederken uyarması gerekiyor. Aşağıdaki kodu inceleyip hata nereden kaynaklanıyor. Yardımcı olabilirmisiniz.

Private Sub CommandButton2_Click()

' Mükerrer Kayıt Kontrolü
Say = WorksheetFunction.CountIf(Sheets("Bordro").Range("B8:B50"), TextBox6.Text)
If Say > 0 Then
MsgBox TextBox6.Value & " TC Nolu " & TextBox7.Value & " " & TextBox8.Value & " Kişisine Ait Kayıt Önceden Girilmiştir !" & vbNewLine & _
"LÜTFEN BİLGİLERİNİZİ KONTROL EDİNİZ!...", vbCritical, "Mükerrer Kayıt Uyarısı"
Exit Sub


End If
Satir = WorksheetFunction.CountA(Worksheets("Bordro").Range("A:A")) + 4
Worksheets("Bordro").Cells(2, 1) = ComboBox1.Value & " " & ComboBox7.Value & " DÖNEMİNE AİT 3 AYLIK ARAZİ TAZMİNATI BORDROSU"
If TextBox14.Value = "" Then
MsgBox " ARAZİ GÜN SAYISI BOŞ GEÇİLEMEZ!..."

Else

If Satir = 6 Then
Worksheets("Bordro").Cells(Satir, 1) = 1
Worksheets("Bordro").Cells(Satir, 2) = TextBox6.Value
Worksheets("Bordro").Cells(Satir, 3) = TextBox7.Value
Worksheets("Bordro").Cells(Satir, 4) = TextBox8.Value
Worksheets("Bordro").Cells(Satir, 5) = TextBox9.Value
Worksheets("Bordro").Cells(Satir, 6) = TextBox10.Value
Worksheets("Bordro").Cells(Satir, 7) = TextBox11.Value
Worksheets("Bordro").Cells(Satir, 8) = TextBox12.Value
Worksheets("Bordro").Cells(Satir, 9) = TextBox13.Value
Worksheets("Bordro").Cells(Satir, 10) = TextBox14.Value
Worksheets("Bordro").Cells(Satir, 11) = TextBox15.Value

Else

Worksheets("Bordro").Cells(Satir, 1) = Worksheets("Bordro").Cells(Satir - 1, 1) + 1


Worksheets("Bordro").Cells(Satir, 2) = TextBox6.Value
Worksheets("Bordro").Cells(Satir, 3) = TextBox7.Value
Worksheets("Bordro").Cells(Satir, 4) = TextBox8.Value
Worksheets("Bordro").Cells(Satir, 5) = TextBox9.Value
Worksheets("Bordro").Cells(Satir, 6) = TextBox10.Value
Worksheets("Bordro").Cells(Satir, 7) = TextBox11.Value
Worksheets("Bordro").Cells(Satir, 8) = TextBox12.Value
Worksheets("Bordro").Cells(Satir, 9) = TextBox13.Value
Worksheets("Bordro").Cells(Satir, 10) = TextBox14.Value
Worksheets("Bordro").Cells(Satir, 11) = TextBox15.Value




GenelT = TextBox15.Value * TextBox2 * 9500 / 100
Damga = GenelT * TextBox4.Value / 100
Netödenen = GenelT - Damga
Worksheets("Bordro").Cells(Satir, 12) = GenelT
Worksheets("Bordro").Cells(Satir, 13) = GenelT
Worksheets("Bordro").Cells(Satir, 14) = Damga
Worksheets("Bordro").Cells(Satir, 15) = Damga
Worksheets("Bordro").Cells(Satir, 16) = Netödenen
End If

End If



TextBox14.Value = ""
TextBox15.Value = ""


End Sub

 

[ÖmerFaruk]

Sheets("Bordro").Range("B8:B50") aralığınızdaki aradığınız kişinin yazılışlarını kontrol edin.
Karekter ya da boşluk uyuşmazlığı vardır.

 

[ormancı421]

TC No'larını kontrol ediyor

 

[ÖmerFaruk]

Aralıktaki TC nolar ya da Textbox da yazdığınız TC No yanlış ya da hatalı olmadığı sürece neden
Say = WorksheetFunction.CountIf(Sheets("Bordro").Range("B8:B50"), TextBox6.Text)
bu satır sıfır sonucunu üretsin ki!!

Sonuçta ilk mesajınızda bahsettiğiniz Mükerrer Kayıt mesajını alıyorsanuz tek sıkıntı bu işlemin sonucu gözüküyor.
Sebebi de ya B8:B50 aralığında ya da TextBox6 da gizli

 

[Necdet]

Sadece kodlardan hareketle olayı çözmek zor, dosyayı da görmek gerekir.

Aşağıdaki gibi dener misiniz, bakalım farklı sonuç oluşacak mı?

    Dim c   As Range
    
    Set c = Sheets("Bordro").Range("B8:B58").Find(TextBox6.Text, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        MsgBox "Mükerrer Kayıt......"
    End If

 

[ormancı421]

Denedim olmadı Necdet bey İlginize Teşekkür ederim.

 

[Necdet]

e o zaman dosyayı görmek gerek, vardır bir nedeni.