Soru Userform da listbox veri çekme

[emrebenn]

Merhaba
Çok fazla tablo ile çalışma yapmaktayım yaklaşık 33 tane tablo ile çalışma yapıyorum.Aynı sayfada tablolar arasında gezinmek zor olduğundan kendime bir user form hazırladım fakat bir noktada tıkandım.

Yardımınızı rica ettigim konu linkte paylaştığım userform da Projeler listbox1 de proje isimlerini görmek (sheet1!E1:G) Bir nevi index olarak kullanmak istiyorum.
Projeler listbox ında görülen proje ismine tıklayınca Kırnım listbox2 de proje isminin yer aldığı tabloyu görmek mümkünmü dür.Bu tablolar dinamiktir en son satırı görecek şekilde görüntülemek gerekmekte.

Not: Proje isimlerinin olduğu hücreleri belirtmek için yeşil renk ile vurguladım.Her proje isminin kendi tablosu vardır.

Örnek dosyam linktedir.

https://dosya.co/bx8wlagoc4jl/PROJELER.xlsm.html

 

[Korhan Ayhan]

Deneyiniz.

Private Sub ListBox1_Click()
    Dim S1 As Worksheet, Bul As Range, Son As Long
    
    If ListBox1.ListIndex > -1 Then
        Set S1 = Sheets("Sheet1")
        Set Bul = S1.Range("K1:XFD1").Find(ListBox1.Value, , , xlWhole)
        If Not Bul Is Nothing Then
            ListBox2.ColumnCount = Bul.CurrentRegion.Columns.Count
            ListBox2.ColumnHeads = True
            ListBox2.RowSource = Bul.CurrentRegion.Offset(1).Resize(Bul.CurrentRegion.Rows.Count - 1).Address
        End If
    End If
    
    Set Bul = Nothing
    Set S1 = Nothing
End Sub

Private Sub UserForm_Initialize()
    ListBox1.RowSource = "Sheet1!E2:E" & Sheets("Sheet1").Cells(Rows.Count, 5).End(3).Row
    ListBox3.RowSource = "Sheet1!A2"
    ListBox3.ColumnWidths = 30
    ListBox4.RowSource = "Sheet1!A4"
    ListBox4.ColumnWidths = 30
End Sub

 

[ÖmerFaruk]

Öncelikle ListBox3 ve ListBox4 deiye tanımladığınız alanlarda TextBox ya da Label nesnesi kullanmanız daha doğru. Zira A2 ve A4 hücrelerindeki iki adet veriyi bu iki alana yazırıyorsunuz

Proje sayısı altındaki mesela TextBox10 olsun
Initialzie olayındaki ListBox3 kodları yerine aşağıdaki tek bir satırı kullanabilrisiniz

TextBox10=Sheets("Sheet1").Range("A2")

Gelelim Projeler Listboxu olacak olan Listbox1 e
Userform Initialize olayına şu kodları ekleyin

SonProje = Sheets("Sheet1").Range("E1").End(xlDown).Row
ListBox1.RowSource = "Sheet1!E2:E" & SonProje

ListBox2 için de Şu kodları da direkt userformun kod sayfasına yapıştırın.

Private Sub ListBox1_Click()
Dim Bul As Range
Dim Son As Integer
ListBox2.Clear
Set Bul = Sheets("Sheet1").Rows("1").Find(ListBox1.Value, , , xlWhole)
If Not Bul Is Nothing Then
    Son = Sheets("Sheet1").Cells(1, Bul.Column).End(xlDown).Row
    Veri = Sheets("Sheet1").Range(Cells(2, Bul.Column), Cells(Son, Bul.Column + 8)).Value
    ListBox2.ColumnCount = UBound(Veri, 2)
    ListBox2.List = Veri
End If
End Sub

 

[Ziynettin]

Alternatif,

Yeni form üzerinde yapılan çalışma. Listbox1 deki projelere çift tıklandığında verileriniz Listbox2 ye aktarılıyor.

Dosyanız

 

[emrebenn]

Ziynettin bey altın üye olmadığım için dosyayı indiremiyorum.Farklı bir yol ile dosyayı paylaşmanız mümkün mü acaba.
Yinede cevap yazıp yardımını esirgemeyen herkese teşekür ederim.

 

[emrebenn]

Bu arada Korhan beyin verdigi kodu kullandığımda Listbox 2 nin içine tablo bilgileri gelmiyor.

Ömer beyin verdigi kodları kullandığımda ise aşağıdaki satırda bir hata uyarısı veriyor.

Veri = Sheets("Sheet1").Range(Cells(2, Bul.Column), Cells(Son, Bul.Column + 8)).Value

 

[Korhan Ayhan]

Deneyerek ve olumlu sonuç alarak kodları paylaşmıştım.

 

[emrebenn]

Merhaba Korhan bey muhtemelen ben fark etmedigim bir hata yapıyor olabilirim.Ekran görüntüm linkteki gibi.
Sizden rica etsem dosyanın çalışan halini paylaşa bilirmisiniz.

https://dosya.co/ux9i9iu8dkhi/Proje.JPG.html

 

[Ziynettin]

Dosyanız yazısı harici link.

 

[emrebenn]

Ziynettin uyarınız için çok teşekürler. Yardımlarınız için ve emeginiz için hepinize teşekkürcederim.

 

[ÖmerFaruk]

Bu arada Korhan beyin verdigi kodu kullandığımda Listbox 2 nin içine tablo bilgileri gelmiyor.

Ömer beyin verdigi kodları kullandığımda ise aşağıdaki satırda bir hata uyarısı veriyor.

Veri = Sheets("Sheet1").Range(Cells(2, Bul.Column), Cells(Son, Bul.Column + 8)).Value

Hata oluştuğunda Son ve Bul.Column değişkenlerinin aldığı değer bakmanız lazım.
Son > 1
Bul.Column >0
olmak zorunda. Eğer olmamışsa Excel sayfanızda verdiğiniz örneklere uygun bir tablo yoktur.

 

[Korhan Ayhan]

İki adet kod bloğu paylaştım.

Aynı isimde sizde olanları silip benim verdiklerimi uygularsanız sorun olmaması gerekir.