Çözüldü Dinamik listbox

[iucfatih]

S.a Hayırlı geceler. Youtube da izlediğim birşeyi kendime göre uygulayamadım. bir el atabilirmisiniz? 2. listbox a veriler tam geçmiyor. örnek dosya ektedir.
Youtube da izlediğim video linki:

Şimdiden teşekkür ederim.

 

[cems]

Tam olarak ne yapmak istediğinizi burada söylerseniz , video izlerken bulmaya çalışmakla zaman kaybetmeden çözülmüş olabilirdi .

 

[iucfatih]

Tam olarak ne yapmak istediğinizi burada söylerseniz , video izlerken bulmaya çalışmakla zaman kaybetmeden çözülmüş olabilirdi .

1. listboxda çerçeve içine aldığım hücrelerdeki ilk hücreler yazacak. ikincide ise 1. listboxda seçtiğimin karşılığı gelecek

 

[veyselemre]

Sayfa üzerinde birbirine bağlı listboxlar.

İlgili sayfanın kodları;

Public dic As Object

Private Sub ListBox1_Click()
    If dic Is Nothing Then Call yenile
    ListBox2.List = Split(Mid(dic(ListBox1.Text), 2), "|")
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call yenile
End Sub

Sub Worksheet_Activate()
    Set dic = CreateObject("Scripting.Dictionary")
    Call yenile
End Sub

Sub yenile()
    If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
    dic.RemoveAll
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        ky = Cells(i, 1).Value
        dic.Item(ky) = dic.Item(ky) & "|" & Cells(i, 2).Value
    Next i
    ListBox1.List = dic.keys
End Sub

 

[iucfatih]

Sayfa üzerinde birbirine bağlı listboxlar.

İlgili sayfanın kodları;

Public dic As Object

Private Sub ListBox1_Click()
    If dic Is Nothing Then Call yenile
    ListBox2.List = Split(Mid(dic(ListBox1.Text), 2), "|")
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call yenile
End Sub

Sub Worksheet_Activate()
    Set dic = CreateObject("Scripting.Dictionary")
    Call yenile
End Sub

Sub yenile()
    If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
    dic.RemoveAll
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        ky = Cells(i, 1).Value
        dic.Item(ky) = dic.Item(ky) & "|" & Cells(i, 2).Value
    Next i
    ListBox1.List = dic.keys
End Sub

burda bug veriyor hocam ListBox1.List = dic.keys

 

[veyselemre]

 

[iucfatih]

Ekli dosyayı görüntüle 205192

oraları temizledim ama bu seferde düzgün çalışmıyor, hem listede 1 tane boşluk var hemde tıklandığında geçiş yapmıyor

 

[iucfatih]

videoyu izleyerek hallettim, veriler bir sayfada diğeri bir sayfada olarak yapıyordum, ikisiniz tek sayfada yapınca oldu, emekleriniz için çok teşekkür ederim, hayırlı günler

 

[veyselemre]

Linkteki dosyayı indirdiniz mi? Veriler A1:B1 den başlayacak, kodlar o şekilde yazıldı.

 

[iucfatih]

Linkteki dosyayı indirdiniz mi? Veriler A1:B1 den başlayacak, kodlar o şekilde yazıldı.

çok özür dilerim ben o linki görmedim, çok güzel çalışıyor yaptığınız, zaten oldu dediğim olmamışmış kapatıp açınca sapıttı elinize sağlık çok teşekkür ederim