Seçili Açıklamaya Ulaşma

[seddur]

Aşağıdaki kod ile "B" sütunundaki tarih ve "A" sütunundaki isme göre excel sayfasındaki hücreye açıklama ekliyorum.Fakat eklediğim bu kayıtlara ulaşabilmem gerekiyor.Yapmak istediğim Combobobox1''den seçili isme ve Textbox1'den seçili tarihe göre o kişiye ait açıklamayı textbox2'de göstermek.Combobox1'de isimler,Textbox1'de ise tarih var."A" sutununda çok sayıda aynı isim var bu yüzden tarih kriterinide kullanıyorum.Yardımcı olusanız sevinirim.
Dim trh As Date, ara As String, deg As String, c As Range, Adr As String

trh = TextBox1
ara = ComboBox1
deg = TextBox2

If deg = "" Then
MsgBox "Önce Açıklama Girin", vbInformation
Exit Sub
End If

Set c = [A:A].Find(ara, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do
If Cells(c.Row, "B") = trh Then
Cells(c.Row, "A").ClearComments
Cells(c.Row, "A").AddComment
Cells(c.Row, "A").Comment.Text Text:=""
Cells(c.Row, "A").Comment.Text Text:=deg
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 Eklendi", vbInformation
Else
MsgBox "Veri Bulunamadı", vbInformation
End If

 

[seddur]

Aşağıda birşeyler yaptım ama çalışmıyor,Düzeltebilecek arkadaş varsa yardım edebilir mi?

TextBox2.Value = Sheets("Takip").Columns(1).Find(ara, , xlValues, xlWhole) And Sheets("Takip").Columns(2).Find(trh, , xlValues, xlWhole).Comment.Text

 

[Saban Sertkaya]

Merhabalar
Örnek dosya ekleyebilir misiniz ? (Alternatif link ile)

 

[Saban Sertkaya]

Yada şöyle yapabilirsiniz.

For a = 1 to [A1048576].end(xlup).row
if cells(a,1) = textbox1 and cells(a,2) = combobox1 then textbox2 = cells(a,1).comment.text
next a

 

[seddur]

Textbox7,8 ve 11 no'ya girdiğim verileri "A","B","C" sutunlarına açıklama olarak ekliyorum.Daha sonra bu açıklamaları ilgili textbox'larda aratıp görmek istiyorum.Burada dikkat edilecek şey "A" sütununda birden fazla aynı isim var.Kodu GÖSTER butonuna yazarsınız.Dosyayı aşağıda ekliyorum.

Kitap7.xlsm dosyasını indir - download

Kitap7.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[Saban Sertkaya]

Merhabalar, dosyayı inceleyiniz. Açıklamalar, 1, 2 ve 3.sütunlardan alınıyor.
Yanlışlık var ise kendinize göre revize edersiniz.

İndir Kitap7

Dosyayı indir Kitap7

dosya.co

Bir de, şu ifadeniz biraz emrivaki olmuş.
"Kodu GÖSTER butonuna yazarsınız."

 

[seddur]

Karıştırmayayım diye yazmıştım ama bu ifade için özürlerimi iletiyorum.Amacını aştığı anlaşılıyor.Ayrıca ilgilendiğiniz için de çok teşekkür ederim.

 

[Saban Sertkaya]

Can sağlığı olsun. Bazen yanlış yazımlar yapabiliyoruz.

Kodda şu hatayı farkettim. Eğer açıklama yok ise hata veriyor. Bu hata için şu şekilde revize yapınız lütfen.

If ComboBox1 = "" Or TextBox2 = "" Then
MsgBox "Lütfen hasta seçimi ile birlikte tarih giriniz"
Exit Sub
End If

For a = 15 To [A65536].End(xlUp).Row
If Cells(a, 1) = ComboBox1 And CDate(Cells(a, 2)) = CDate(TextBox3) Then
On Error Resume Next
TextBox11 = ""
TextBox11 = Cells(a, 1).Comment.Text
TextBox11 = TextBox11 & " - " & Cells(a, 2).Comment.Text
TextBox11 = TextBox11 & " - " & Cells(a, 3).Comment.Text
End If
Next a