AccessTr.neT

Bul · 14/03/2021, 12:25

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.

[Resim: do.php?img=10800]

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

Bul · 14/03/2021, 14:04

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

burdaki

Kod:

Columns(1)

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.

Bul · 14/03/2021, 16:17

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.

[Resim: do.php?img=10801]

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

Bul · 14/03/2021, 16:40

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.

Bul · 14/03/2021, 16:54

(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.

Bul · 14/03/2021, 18:45

(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.

AccessTr.neT

Excel Userformda Mükerrer Kayıt Engelleme

Excel Userformda Mükerrer Kayıt Engelleme

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Giriş yap

Hesap oluştur

Konu Linkleri