Açıklama olan hücreleri bulma ve listeleme

[seddur]

Merhaba.Yardım istediğim konu şöyle; "A" sutununda isim,"B" sutununda tarih, "C" sutununda ilaç adları var ve "A" sutununda çok sayıda aynı isim var ve bunların bazıların da açıklamalar ekli.Açıklamalar "C" sutunundaki hücrelere yazdırılıyor.Yapmak istediğim Textbox1 e girilen isme göre o isme ait açıklama yazılmış hücrelerin listesini listview1'de almak.Açıklama olmayan hücreler listelenmeyecek.
Yardımlarınız için Teşekkür ediyorum.

 

[Korhan Ayhan]

İnceleyiniz.

Sorgu için arama sonuçları: comment

www.excel.web.tr

 

[seddur]

Açıklamaların içeriği listelenmeyecek sadece Açıklama bulunan satırlar listelenecek.Aşağıdaki kodu yazdım ama çalışmıyor hata veriyor.
Set S1 = Sheets("Kayıt")
For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
If S1.Range("A" & i).Value = UserForm1.TextBox1.Text and S1..Range("C" & i).Comment.Text <> "" Then
Set List = .ListItems.Add(, , S1.Cells(i, "b").Text)
List.ListSubItems.Add , , S1.Cells(i, "c").Text

End If
Next

 

[Korhan Ayhan]

Kontrol için sayfanızda ilk hücreye açıklama ekleyin. Sonra yazdığınız kodu F8 ile adım adım çalıştırıp kodda ki hatanızı tespit edin. Sonra gerekli düzeltmeleri yaparsınız.

 

[seddur]

Yaptım ama bu satır hata veriyor.Nedenini çözemedim.Comment.text yerine ne yazılabilir
If S1.Range("A" & i).Value = UserForm1.TextBox1.Text and S1..Range("C" & i).Comment.Text <> "" Then

 

[Korhan Ayhan]

Döngü içine aşağıdaki satırı ekleyip deneyin bakalım açıklamayı gösterecek mi?

MsgBox S1..Range("C" & i).Comment.Text

 

[seddur]

Döngü içine yazdım açıklamayı gösteriyor.Olmazsa dosya ekleyim

 

[alicimri]

ALTERNATİF:
Sadece hücre adreslerini listelemek istiyorsanız kodu kullana bilirsiniz.

Sub Makro1()
Cells.SpecialCells(xlCellTypeComments).Select
ayir = Split(Selection.Address, ",")
For i = 0 To UBound(ayir)
For e = 1 To Range(ayir(i)).Count
MsgBox Replace(Range(ayir(i))(e).Address, "$", "")
Next
Next
End Sub

NOT:
Msgboxa gelen verileri siz listboxa uyarlayın.

 

[seddur]

Hücre adresleri değil açıklama olan satırlar listelenecek.Ekran görüntüsünde gözüken F-G-H sutunlarındaki gibi listviewde gözükecek.

 

[alicimri]

Örneğn F sütunu için
MsgBox Cells(Range(ayir(i))(e).Row, "F")
gibi olabilirmi

 

[alicimri]

Herhalde böyle bir şey
listwiew siz uyarlayın.

Sub Makro1()
Columns(1).SpecialCells(xlCellTypeComments).Select
ayir = Split(Selection.Address, ",")
For i = 0 To UBound(ayir)
For e = 1 To Range(ayir(i)).Count
If Cells(Range(ayir(i))(e).Row, "A") = TextBox1.Value Then
MsgBox Cells(Range(ayir(i))(e).Row, "A")
MsgBox Cells(Range(ayir(i))(e).Row, "B")
MsgBox Cells(Range(ayir(i))(e).Row, "C")
End If
Next
Next
End Sub

 

[seddur]

Evet şimdi oldu.Kod aşağıdaki şekilde çalışıyor.Tekrar Teşekkür Ederim.

With UserForm1.ListView1
UserForm1.BackColor = RGB(0, 102, 102)
.BackColor = RGB(0, 102, 102)
.ForeColor = RGB(0, 0, 0)
.Font.Name = calibri
.Font.Bold = True
.ForeColor = RGB(255, 255, 255)
.Font.Size = 11
.FullRowSelect = True
.View = lvwReport
.Gridlines = True
.ColumnHeaders.Add , , "İSİM", 90, lvwColumn
.ColumnHeaders.Add , , "TARİH", 100, lvwColumn
.ColumnHeaders.Add , , "İLAÇ ADI", 100, lvwColumn
.ListItems.Clear
Set S1 = Sheets("Kayıt")
Columns(3).SpecialCells(xlCellTypeComments).Select
ayir = Split(Selection.Address, ",")
For i = 0 To UBound(ayir)
For e = 1 To Range(ayir(i)).Count
If S1.Cells(Range(ayir(i))(e).Row, "A") = TextBox1.Value Then
Set List = .ListItems.Add(, , S1.Cells(Range(ayir(i))(e).Row, "A"))
List.ListSubItems.Add , , S1.Cells(Range(ayir(i))(e).Row, "B")
List.ListSubItems.Add , , S1.Cells(Range(ayir(i))(e).Row, "C")
End If
Next
Next



End With

 

[seddur]

Konu ile ilgili şöyle bir sorun gelişti.Bu kodlar userform da çalışıyor ancak "kayıt" sayfası aktif değilse çalışmıyor. yani userform başka bir sayfada olduğundan kodların başına -sheets("Kayıt").select- yazmam gerekiyor tabi böyle oluncada sayfa değişiyor ve görüntü bozuluyor.Bu durumu nasıl çözebiliriz ?

 

[Korhan Ayhan]

İşlem yapmak için seçim yapmanıza gerek yoktur.

SET ile sayfa tanımlama (S1) yapmışsınız bunu kullanabilirsiniz.

Örnekler;

S1.Range("A1")
S1.Cells(X, 1)
S1.Columns(1)

 

[alicimri]

Set S1 = Sheets("Kayıt") ile End iff arasındaki kodları aşadakiler ile değiştirin

ayir = Split(S1.Columns(3).SpecialCells(xlCellTypeComments).address, ",")
For i = 0 To UBound(ayir)
For e = 1 To S1.Range(ayir(i)).Count
If S1.Cells(S1.Range(ayir(i))(e).Row, "A") = TextBox1.Value Then
Set List = .ListItems.Add(, , S1.Cells(S1.Range(ayir(i))(e).Row, "A"))
List.ListSubItems.Add , , S1.Cells(S1.Range(ayir(i))(e).Row, "B")
List.ListSubItems.Add , , S1.Cells(S1.Range(ayir(i))(e).Row, "C")