Skip to main content

AccessTr.neT


Excel Userformda Mükerrer Kayıt Engelleme

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

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]




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ı: 18)
Access Çekirgesi 
[Resim: img-cray.gif]


Son Düzenleme: 14/03/2021, 12:31, Düzenleyen: Oğuz Türkyılmaz.
Cevapla
#2
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.
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]

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 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.
Cevapla
#5
(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.
Cevapla
#6
(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.
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
Task