Checkbox caption'ı değiştirme

[seddur]

Merhabalar.Aşağıdaki kod ile C sutunundaki isimleri userformdaki checkboxların caption'ları olarak yazdırıyorum. ancak userformdaki diğer checkboxları etkilememesi için sadece checkbox 1 ile 6 arasındaki checkbox captionları değişsin istiyorum. Yardımcı olabilirseniz sevinirim.
Private Sub CommandButton16_Click()
Set S1 = Sheets("Kayıt")
For i = 2 To S1.Cells(Rows.Count, "a").End(xlUp).Row
Me.Controls("CheckBox" & i - 1).Caption = S1.Cells(i, "c").Text
Next:
end sub

 

[ÖmerFaruk]

S1.Cells(Rows.Count, "a").End(xlUp).Row

Eğer bu kodun döndürdüğü değer yani A sütunundaki son satırınız 7 ise kodlarınız doğru çalışacaktır zaten.

Eğer 7 den fazla ise şunu sormamız lazım

2.Satırdaki C sütunundaki değer CheckBox1 'e
3.Satırdaki C sütunundaki değer CheckBox2 'e
.............
7.Satırdaki C sütunundaki değer CheckBox6 'ya

aktardıktan sonra
8.Satırdaki C sütunundaki değeri hangi CheckBox a yazacaksınız?
Ya da son satır numarası 7 den büyükse ne olacak bunu söylemelisiniz

 

[seddur]

Şöyle; C sutunundaki yazılı isimleri önce Tarih ve Ad soyada göre filtre ediyorum zaten bir kişiye aynı tarihde 6 dan fazla ilaç yazılamayacağını varsaydım ve userforma 6 adet checkbox yaptım bu checkboxların isimlerini değiştirdiğimde hangi ilaca açıklama eklemek istiyorsam o checkboxı seçiyorum ve userformdaki textboxa açıklamayı yazarak C sutununda tarih,ad soyad ve ilacın yazılı olduğu hücreye açıklamayı ekliyorum.

 

[ÖmerFaruk]

Filtre ettiğiniz satırlar yerine tüm satırlarda işlem yapıyorsunuz siz.
For i = 2 To S1.Cells(Rows.Count, "a").End(xlUp).Row

Dosyanızı tam olarak paylaşırsanız Dizilerle hızlı işlem yaptırabiliriz.
Ya da For-Next döngüsünü bunun gibi değil şöyle yapmalısınız.

Private Sub CommandButton16_Click()
Set S1 = Sheets("Kayıt")
Say = 0
For i = 2 To S1.Cells(Rows.Count, "a").End(xlUp).Row
    If S1.Cells(i, "A") = Tarih Then        ' bu satırı kendi sayfa ve userformunuza göre düzenleyeceksiniz.
        If S1.Cells(i, "B") = HastaAdı Then ' bu satırı kendi sayfa ve userformunuza göre düzenleyeceksiniz.
            Say = Say + 1
            Me.Controls("CheckBox" & Say).Caption = S1.Cells(i, "c").Text
        End If
    End If
Next
End Sub

Dosyanız elimizde olmadığı için denemeden yolluyorum

 

[seddur]

Tamam. Bu aralar excel'e fazla zaman ayıramıyorum, dosyayı kendimce toparlayıp bir kaç gün içinde buradan paylaşayım.

 

[seddur]

Dosyayı paylaşıyorum.Userformu açmak için Randevu sayfasındaki Tık işareti olan butona tıklayın açılan userformdaki ismin üzerine tekrar tıklayın Userform4 açılacaktır.Userformdaki HASTA BİLGİLERİ butonuna tıklayınca hastanın kullandığı ilaç isimleri checkboxlarda ve listview'de listelenecektir.
Sorun1:
Tanı ve doktor notu yazan checkboxı işaretledikten sonra textbox4'e yazılan notlar aynı isim ve tarihe ait bütün satırlara aynı açıklamayı ekliyor tek satıra indirme imkanı varmı?
Sorun2:
Açıklama silme butonu sağlıklı çalışmıyor.Örneğin şu anda Veri Bulunamadı uyarısı veriyor.Yeniden kod yazılabilir mi ya da düzeltilebilir mi?
Sorun 3:
Hastaya yazılan ilaç sayısı 6 dan fazla olursa Tanı checkbox'ını ve olası diğer checkboxları etkiliyor bu yüzden önlem alınabilirmi?
NOT:Herhangi bir sorunuz olursa saat 15:00 den sonra cevap verebileceğim.

 

[seddur]

Userformdaki checkbox sayısını 6 ya düşürmeye karar verdim.Onun dışında aşağıdaki kodlar ile "A" ve "B" sutunlarında bulunan hücredeki açıklamaları siliyor idim.Ancak şu anda "Veri bulunamadı" uyarısı alıyorum.Nedenini bulamıyorumAcaba bu kodlar üzerinde yeniden düzenleme yaparak yardımcı olabilir misiniz?

Set S1 = Sheets("Kayıt")
trh = UserForm4.TextBox2
ara = UserForm4.TextBox19.Value

Set c = [A:A].Find(ara, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
If Cells(c.Row, "A") = ara And Cells(c.Row, "B") = trh Then
S1.Cells(c.Row, "A").ClearComments
S1.Cells(c.Row, "B").ClearComments
s = 1
End If
Set c = [A:A].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If

If s = 1 Then
MsgBox "Açıklama Silindi", vbInformation
TextBox4 = Clear
Else
MsgBox "Veri Bulunamadı", vbInformation
End If