AccessTr.neT

Herkese sağlıklı günler.
EXCEL User Formda Mükerrer kayıt yapıldığında uyarsın, istendiği takdirde kayıt gerçekleşsin diye yazdığım kod mükerrer kaydı bana bildiriyor fakat kayıt yap dediğimde kayıt mükerrer olsun olmasın kaydı ilk boş satıra değil de 2 ayrı satıra boşluk bırakarak yapıyor. Bu hatayı nasıl düzeltebilirim. Sayfa koruma parolası 171717 Kaldırmayı unutmuşum özür dilerim.

Private Sub btn_KayitEkle_Click()



If MsgBox("Girdiginiz veriler kaydedilecektir, Emin misiniz...?", vbExclamation + vbYesNo, "Firma Tanımlama Formu") = vbNo Then Exit Sub



Dim Firma, YeniFirma



Firma = TextBox_FirmaAdi.Value



YeniFirma = IIf(Application.CountIf(Columns(1), Firma) > 0, 1, 0)



If YeniFirma > 0 And TextBox_FirmaAdi.Value <> "" Then



If MsgBox("Aynı Adla Yapılmış Firma Kaydı Bulundu...Kayıt Yapılsın mı...?", vbExclamation + vbYesNo, "Firma Tanımlama Formu") = vbNo Then Exit Sub



Else



Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Firma



End If





' Application.ScreenUpdating = False



    With ThisWorkbook.Worksheets("Ana_Sayfa")

    '    .Unprotect sifre

        SonSatir = WorksheetFunction.CountA(.Range("A:A")) + 1

        

        .Cells(SonSatir, 1) = WorksheetFunction.Max(.Range("A2:A" & Rows.Count)) + 1

        .Cells(SonSatir, 2) = TextBox_FirmaAdi.Value

        .Cells(SonSatir, 3) = TextBox_FirmaUnvani.Value

        .Cells(SonSatir, 4) = TextBox_YetkiliKisi.Value

        .Cells(SonSatir, 5) = TextBox_Telefon.Value

        .Cells(SonSatir, 6) = TextBox_Gsm.Value

        .Cells(SonSatir, 7) = TextBox_Email.Value

        .Cells(SonSatir, 8) = TextBox_Adres.Value

        .Cells(SonSatir, 9) = TextBox_Aciklama.Value

        .Cells(SonSatir, 10) = ComboBox_Ilce.Value

        .Cells(SonSatir, 11) = ComboBox_Sehir.Text

        .Cells(SonSatir, 12) = ComboBox_Bolge.Value

        .Cells(SonSatir, 13) = ComboBox_Temsilci.Value

        .Cells(SonSatir, 14) = ComboBox_RouteDay.Value

        .Cells(SonSatir, 15) = ComboBox_YetkiliBayilik

        .Cells(SonSatir, 16) = CheckBox_AlbertGenau.Value

        .Cells(SonSatir, 17) = CheckBox_AsasPen.Value

        .Cells(SonSatir, 18) = CheckBox_ByErtTente.Value

        .Cells(SonSatir, 19) = CheckBox_Karpen.Value

        .Cells(SonSatir, 20) = CheckBox_OptimalYapi.Value

        .Cells(SonSatir, 21) = CheckBox_Palmiye.Value

        .Cells(SonSatir, 22) = CheckBox_Rsg.Value

        .Cells(SonSatir, 23) = CheckBox_Vizyon.Value

        .Cells(SonSatir, 24) = CheckBox_Winsa.Value

        .Cells(SonSatir, 25) = CheckBox_Diger.Value

        .Cells(SonSatir, 26) = TextBox_Tarih.Value

    '    .Protect sifre

    End With

    Call checkboxKontrol(SonSatir)

    Call temizle



    TextBox_Tarih = Format(Date, "dd.mm.yyyy")

    

    TextBox_Tarih.SetFocus

    

    With TextBox_Tarih

        .SelStart = 0

        .SelLength = .TextLength

    End With

'Application.ScreenUpdating = True



End Sub

YeniFirma = IIf(Application.CountIf(Columns(1), Firma) > 0, 1, 0) 

burdaki
yerine

Columns(2)

yazınız.

SonSatir = WorksheetFunction.CountA(.Range("A:A")) + 1 

yerinede

SonSatir = .Range("A" & Rows.Count).End(3).Row + 1

bunu ekleyin.

Feraz Hocam İlk Kaydı düzgün yaptı 2.sinde resimdeki gibi kaydetti. Eğer aynı kayıttan varsa 2.sini düzgün kaydediyor ama aynı kayıttan yoksa yeni kaydı resimdeki gibi yapıyor.

Private Sub btn_KayitEkle_Click()



If MsgBox("Girdiginiz veriler kaydedilecektir, Emin misiniz...?", vbExclamation + vbYesNo, "Firma Tanımlama Formu") = vbNo Then Exit Sub



Dim Firma, YeniFirma



Firma = TextBox_FirmaAdi.Value



YeniFirma = IIf(Application.CountIf(Columns(2), Firma) > 0, 1, 0)



If YeniFirma > 0 And TextBox_FirmaAdi.Value <> "" Then



If MsgBox("Aynı Adla Yapılmış Firma Kaydı Bulundu...Kayıt Yapılsın mı...?", vbExclamation + vbYesNo, "Firma Tanımlama Formu") = vbNo Then Exit Sub



Else



Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Firma



End If





' Application.ScreenUpdating = False



    With ThisWorkbook.Worksheets("Ana_Sayfa")

    '    .Unprotect sifre

        'SonSatir = WorksheetFunction.CountA(.Range("A:A")) + 1

        

        SonSatir = .Range("A" & Rows.Count).End(3).Row + 1

        .Cells(SonSatir, 1) = WorksheetFunction.Max(.Range("A2:A" & Rows.Count)) + 1

5.satıra neden id yazmamış.Pc elime geçince bakarım abey.

---

(14/03/2021, 16:17)Oğuz Türkyılmaz yazdı: [ -> ]Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Firma

Bunu neden yazdınız 1.sütun için.Mobilden gördüm.

(14/03/2021, 12:25)Oğuz Türkyılmaz yazdı: [ -> ]Else
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Firma

Önce burayı silip deneyin.üstündeki mesajdada aynı firma varsa diyor ve evet hayır diye şart koşmuşsunuz.Aynı firma varsa ve aynısı eklenmeyecekse orasıda değişmeli.

(14/03/2021, 16:54)feraz yazdı: [ -> ]

(14/03/2021, 12:25)Oğuz Türkyılmaz yazdı: [ -> ]Else
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Firma

Önce burayı silip deneyin.üstündeki mesajdada aynı firma varsa diyor ve evet hayır diye şart koşmuşsunuz.Aynı firma varsa ve aynısı eklenmeyecekse orasıda değişmeli.

Ayni firma varsa ve eklenmeyecekse zaten hayır ile exit sub ile kaydetmeden çıkartıyorum. Else bölümünü silince istediğim şekilde kayıt yaptı Feraz Hocam Teşekkür ederim.