Açıklama kutusundakileri süzme

[fehdur]

Aşağıdaki kod ile "Anasayfa" "L" süununda bulunan açıklamaların dökümünü Listbox1 'e alıyorum.Yapmak istediğim bu açıklamalardaki değerlere göre döküm almak.Örneğin açıklama kutusunda "A BLOK-1+1 _KAT:2" yazdığını varsayalım.Bu şekilde açıklaması bulunan satırların dökümünü listboxda almak istiyorum.Aslında bu dairede dönüşümlü oturan kişilerin listesi alınacak..Yani comboboxdaki yazan adrese göre listboxda süzme yapılacak..Umarım anlaşılır olmuştur.Teşekkür ederim.


ListBox1.Clear
With Sheets("Anasayfa")
On Error Resume Next
For i = 15 To .Range("L65536").End(3).Row
If Not .Range("L" & i).Comment Is Nothing Then
If Trim(Replace(.Range("L" & i).Comment.Text, Chr(10), "")) <> "" Then
ListBox1.AddItem
ListBox1.List(UserForm18.ListBox1.ListCount - 1, 0) = .Range("L" & i)
ListBox1.List(UserForm18.ListBox1.ListCount - 1, 1) = .Range("L" & i).Comment.Text
End If: End If
Next
End With

 

[Murat OSMA]

AddItem satırından sonra bu satırı ilave edin, açıklama içindeki metni de göstermiş olursunuz.
ListBox1.ColumnCount = 2

 

[fehdur]

Açıklama içindeki metnin dökümünü alabiliyorum dolayısıyla metinleri görüyorum.5 değişik açıklamalardan oluşan sayfam var.Benim istediğim Comboboxdan herhangi birini seçtiğimde seçili olanın dökümü gelsin.

 

[fehdur]

Yapılacak çalışmanın mantığı şu:
1-Önce listbox'a döküm alınacak
2-Alınan dökümün adresi yani 2.sütun daki değerler combobox'da süzdürülecek
Yukarıdaki kod ile zaten döküm almaktayız.Koda ilave yapılacak.2.listbox yapılabilir.

 

[fehdur]

Aşağıdaki kod ile sorunu çözdüm.Arşiv için paylaşıyorum.

With ListView2
Set S1 = Sheets("Anasayfa")
For i = 15 To Sheets("Anasayfa").Range("O65536").End(3).Row
If Not Sheets("Anasayfa").Range("O" & i).Comment Is Nothing Then
If Trim(Replace(Sheets("Anasayfa").Range("O" & i).Comment.Text, Chr(10), "")) = ComboBox23.Value Then

Set List = .ListItems.Add(, , S1.Cells(i, "a").Text)
List.ListSubItems.Add , , S1.Cells(i, "c").Text
List.ListSubItems.Add , , S1.Cells(i, "f").Text
List.ListSubItems.Add , , S1.Cells(i, "g").Text
List.ListSubItems.Add , , S1.Cells(i, "h").Text
List.ListSubItems.Add , , S1.Cells(i, "ı").Text
List.ListSubItems.Add , , S1.Cells(i, "j").Text
List.ListSubItems.Add , , S1.Cells(i, "k").Text

End If: End If
Next
End With