kriterlere göre kayıt

[peleryn]

Herkese merhabalar;

A2:J1523 arasında veriler olan bir tabloda A sütunu 01.Kasım.2009 dan başlıyor ve sıralı giderek 31.12.2013 te bitiyor.

B sütununda günler ve takip eden 8 sütunda başlık olarak saatler var.

UserFormumla bu saatlere tarihlere karşılık gelen randevular dağıtıyorum.

Ancak randevu verirken aynı isme aynı yılın aynı ayında en çok 2 randevu verebilmem lazım.

Gerekli açıklamayı UserForm'un üzerinde de yaptım.

İlgilenecek olanlara şimdiden çok teşekkür ediyorum.

 

[meslan]

Merhaba
CommandButton1_Click()
olayında 5. satırdan sonra,

If kayitli = True Then aranan = adi.Value
If disardan = True Then aranan = kisi.Value
 With Sheets("RANDEVU")
    Set say = .Range("C:J").Find(aranan, lookat:=xlValue)
    If Not say Is Nothing Then
        bslmn = say.Address
        Do
           If Month(CDate(ComboBox5.Value)) = Month(CDate(.Cells(say.Row, 1).Value)) And _
           Year(CDate(ComboBox5.Value)) = Year(CDate(.Cells(say.Row, 1).Value)) Then kayit = kayit + 1
           If kayit > 1 Then MsgBox "Bu Yıl Bu Ay 2 RANDEVU Kayıtlı": Exit Sub
            Set say = .Range("C:J").FindNext(say)
        Loop While Not say Is Nothing And say.Address <> bslmn
    End If
End With

Deneyin.
Kolay gelsin.

 

[peleryn]

Sn Meslan ;

Harika bir çözüm oldu.Birçok deneme yaptım ve çok güzel çalışıyor ellerinize sağlık.

Belki bazı özel durumlarda 3.bir randevu vermem gerekirse (az da olsa olası) dışardan randevu için ayrılan textboxla kayıtlı bir ismi elden yazarak giriş yapabilirim diye düşünerek

If disardan = True Then aranan = kisi.Value

satırını kaldırdım ama düşündüğüm gibi olmadı.adi_change olayındaki kisi.Value=adi.Value değerini değiştirmeden ve kolayca yapılabilecek bir çözümü varsa yardımcı olabilirseniz sevinirim.

 

[meslan]

Merhaba
Şunu deneyin.

 If kayitli = True Then aranan = adi.Value
If disardan = True Then aranan = kisi.Value
 With Sheets("RANDEVU")
    Set say = .Range("C:J").Find(aranan, lookat:=xlValue)
    If Not say Is Nothing Then
        bslmn = say.Address
        Do
           If Month(CDate(ComboBox5.Value)) = Month(CDate(.Cells(say.Row, 1).Value)) And _
           Year(CDate(ComboBox5.Value)) = Year(CDate(.Cells(say.Row, 1).Value)) Then kayit = kayit + 1
          [COLOR="Red"] If kayit > 1 Then sor = MsgBox("Bu Yıl Bu Ay 2 RANDEVU Kayıtlı" & Chr(10) _
           & "Devam edilsin mi", vbYesNo)
           If sor = vbNo Then Exit Sub[/COLOR]            
Set say = .Range("C:J").FindNext(say)
        Loop While Not say Is Nothing And say.Address <> bslmn
    End If
End With

 

[peleryn]

Sn meslan;

Çok teşekkür ederim sizin ve hocalarımın destekleriyle çok kısa zamanda çalışma neredeyse bitti.Ellerinize sağlık ilgi ve desteğiniz için tekrar teşekkür ederim.