Mükerrer Kayda İzin vermesin

[nazifdural]

Merhaba Değerli Üstatlarım,
Ekteki tablomda, spa işletmesinde userfomla rezervasyon girişi yapıyorum.Şöyle bir problemim var.Rezervasyon girişi yaparken Rezervasyon tarihi,Rezervasyon Saati ve terapist kodu aynı olduğunda mükerrer kayıt olduğunu msj ile belirtsin ve kayıt yapmasın.bunu birtürlü halledemedim.Lütfen yardımcı olursanız sevinirim.
Saygılar

 

[calypso17e]

benzer kendi kullandığımı vereim belki işine yarar sizinki gibi değil ama ek kontrol amaçlı kullanabilirsiniz.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kod yapısını kullanabilirsiniz. Veri sayınız arttıkça döngüden daha hızlı sonuç verecektir. Dosyanız bende sürekli hata verdiği için kodu tam olarak deneyemedim.

'....
Set BUL = Sheets("DATA").Range("C:C").Find(What:=TextBox2, LookAt:=xlWhole)
If Not BUL Is Nothing Then
ADRES = BUL.Address
Do
If Sheets("DATA").Cells(BUL.Row, "D") = ComboBox1 And Sheets("DATA").Cells(BUL.Row, "G") = ComboBox2 Then
SAY = SAY + 1
End If
Set BUL = Sheets("DATA").Range("C:C").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
[COLOR=red]End If[/COLOR]
If SAY > 0 Then
MsgBox "Mükerrer Rezervasyon,Saat,Terapist Hatası!!", vbYesNo, "DİKKAT"
Exit Sub
End If
'....

 

[nazifdural]

Üstadım sorunumla ilgilendiğiniz için çok teşekkür ederim.kodlarınızı eklediğimde bir hata ile karşılaşıyorum.denedim fakat birtürlü halledemedim.ben sizin kodları eklemeden hata vermeyen yeni dosyayı ekledim.bana yardımcı olursanız çok sevinirim.

 

[Korhan Ayhan]

Selamlar,

Nazif bey sanırım siz dosyanızı 2007 formatı ile hazırladınız. Ben dosyanızı indirdim. Fakat sürekli hata mesajları alıyorum. Sanırım uyum sorunu var.

 

[nazifdural]

Merhabalar,
Korhan bey, yazmış olduğunuz kodu Commandbutton1 altına eklediğimde şöyle bir mesaj alıyorum. "Compile Error! Block if without end if " ve Commandbutton1 komutunda "end sub" üzeri koyulaşıyor.

 

[Korhan Ayhan]

Selamlar,

Sanırım kodda bir adet End If ifadesini eksik yazmışım #3 nolu mesajımdaki kodu güncelledim. Tekrar denermisiniz.

 

[nazifdural]

Korhan Bey,kodları düzeltilmiş şekilde denedim.malesef yine olmadı.başka ne yapabilirim?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Private Sub CommandButton1_Click()
 
    If TextBox1.Text = "" Then
    MsgBox "İşlem Tarihi Girmeniz Gerekiyor"
    TextBox1.SetFocus
    Exit Sub
    End If
 
    If ComboBox1.Text = "" Then
    MsgBox "Rezervasyon Tarihi Girmeniz Gerekiyor"
    ComboBox1.SetFocus
    Exit Sub
    End If
 
        Set BUL = Sheets("DATA").Range("C:C").Find(What:=TextBox2, LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
        If Format(Sheets("DATA").Cells(BUL.Row, "D"), "hh:mm") = ComboBox1 And Sheets("DATA").Cells(BUL.Row, "G") = ComboBox2 Then
        SAY = SAY + 1
        End If
        Set BUL = Sheets("DATA").Range("C:C").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        If SAY > 0 Then
        MsgBox "Mükerrer Rezervasyon,Saat,Terapist Hatası !", vbYesNo, "DİKKAT"
        Exit Sub
        End If
 
        If Yeni_mi = True Then
 
            With Sheets("Data")
                 Son_Dolu_Satir = .Range("A65536").End(xlUp).Row
                 Bos_Satir = Son_Dolu_Satir + 1
                .Range("A" & Bos_Satir).Value = _
                            Application.WorksheetFunction.Max(.Range("A:A")) + 1
                .Range("B" & Bos_Satir).Value = TextBox1.Text
                .Range("C" & Bos_Satir).Value = TextBox2.Text
                .Range("D" & Bos_Satir).Value = ComboBox1.Text
                .Range("E" & Bos_Satir).Value = TextBox3.Text
                .Range("F" & Bos_Satir).Value = TextBox4.Text
                .Range("G" & Bos_Satir).Value = ComboBox2.Text
                .Range("H" & Bos_Satir).Value = ComboBox3.Text
                .Range("I" & Bos_Satir).Value = ComboBox4.Text
                .Range("J" & Bos_Satir).Value = ComboBox5.Text
            End With
 
        Else
 
            Degistirilecek_Satir = ListBox1.ListIndex + 2
            With Sheets("Data")
                .Range("B" & Degistirilecek_Satir).Value = TextBox1.Text
                .Range("C" & Degistirilecek_Satir).Value = TextBox2.Text
                .Range("D" & Degistirilecek_Satir).Value = ComboBox1.Text
                .Range("E" & Degistirilecek_Satir).Value = TextBox3.Text
                .Range("F" & Degistirilecek_Satir).Value = TextBox4.Text
                .Range("G" & Degistirilecek_Satir).Value = ComboBox2.Text
                .Range("H" & Degistirilecek_Satir).Value = ComboBox3.Text
                .Range("I" & Degistirilecek_Satir).Value = ComboBox4.Text
                .Range("J" & Degistirilecek_Satir).Value = ComboBox5.Text
            End With
        End If
 
    ListBox1.RowSource = "Data!C2:J" & Sheets("Data").Range("A65536").End(xlUp).Row
 
    TextBox2.Text = ""
    ComboBox1.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    ComboBox2.Text = ""
    ComboBox3.Text = ""
    ComboBox4.Text = ""
    ComboBox5.Text = ""
End Sub

 

[nazifdural]

Üstadım sizi de uğraştırıyorum fakat yine olmadı.Ben bu gidişle pes edeceğim galiba.bütün bir kış bu çalışmayı gerçekleştirmek için uğraştım.otelin açılmasına birgün kala bu problemin farkına vardım.Kabus gibi birşey.Bu problem yüzünden dokunsalar ağlayacağım.Sinirlerim bozuldu.Birşeyler yapmalı ama ne?
Üstadım kusuruma bakmayın,İlginiz ve zaman ayırdığınız için çok teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Olmayan kısım nedir. Kod hatamı veriyor.

 

[nazifdural]

Üstadım hata vermiyor..fakat kod hiç çalışmıyor.yani mükerrer kayıt girişi yapıyorum.ne hata veriyor.nede mükerrer kayıt girişini engelleme yapıyor.

 

[Korhan Ayhan]

Selamlar,

#9 nolu mesajımdaki kodu güncelledim. Sanırım sıkıntı saat formatından kaynaklanıyor. Denermisiniz.

 

[nazifdural]

Üstadım,kodları şu an denedim.çalışıyor.harikasınız.Emeğinize,ilginize tekrar tekrar çok teşekkürler