Skip to main content

AccessTr.neT


Excel Userformda Mükerrer Kayıt Engelleme

Oğuz Türkyılmaz
Oğuz Türkyılmaz
6
399

Excel Userformda Mükerrer Kayıt Engelleme

Çözüldü #1
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]




Visual Basic Code
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
.rar WİNPERAX.rar (Dosya Boyutu: 95,96 KB | İndirme Sayısı: 11)
Access Çekirgesi 
[Resim: img-cray.gif]


Son Düzenleme: 14/03/2021, 12:31, Düzenleyen: Oğuz Türkyılmaz.
Cevapla
#2
Visual Basic Code
YeniFirma = IIf(Application.CountIf(Columns(1), Firma) > 0, 1, 0) 
burdaki
Kod
Columns(1)
yerine
Visual Basic Code
Columns(2)
yazınız.

Visual Basic Code
SonSatir = WorksheetFunction.CountA(.Range("A:A")) + 1 
yerinede
Visual Basic Code
SonSatir = .Range("A" & Rows.Count).End(3).Row + 1
bunu ekleyin.
Cevapla
#3
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]

Visual Basic Code
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
Access Çekirgesi 
[Resim: img-cray.gif]


Son Düzenleme: 14/03/2021, 16:20, Düzenleyen: Oğuz Türkyılmaz.
Cevapla
#4
5.satıra neden id yazmamış.Pc elime geçince bakarım abey.

(14/03/2021 16:17)Oğuz Türkyılmaz Adlı Kullanıcıdan Alıntı: 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.
Son Düzenleme: 14/03/2021, 16:41, Düzenleyen: feraz.
Cevapla
#5
(14/03/2021 12:25)Oğuz Türkyılmaz Adlı Kullanıcıdan Alıntı: 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.
Cevapla
#6
(14/03/2021 16:54)feraz Adlı Kullanıcıdan Alıntı:
(14/03/2021 12:25)Oğuz Türkyılmaz Adlı Kullanıcıdan Alıntı: 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.
Access Çekirgesi 
[Resim: img-cray.gif]


Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da