İstenilen kriterlere göre listboxa veri çağırmak.

[hurkanpisirici]

Merhabalar , açılan UserForm da 4 combobox ve birde listbox um var. Benim istediğim basit bir ekstre yapmak .Combobox 1 ve 2 ye b sütunundaki tarikleri getirebiliyorum.Listbox ıma istediğim sutunlarıda getirebiliyorum.İlk sorunum combobox larda seçtiğim kriterlere göre llistboxa verilerin gelmesi.İkinci sorunumda combobox3 e yani firma adı kısmına firma isimlerinin tek tek gelmesi.Yani bir firmadan çok falza olsada sadece bir kere gelmesi.


Yardımlarınız için teşekkürler.Dosyam ekte.

 

[hurkanpisirici]

birde combobox4 e yapıldı ve yapılmadı yazdıramadım.

 

[hurkanpisirici]

combobox4 ü hallettim ama öteki sorunlarıma bir çözüm bulamadım.

 

[ersoyalan]

Merhaba,

Elimdeki örneği gönderiyorum.İşinize yarıyabilir.


E.ALAN

 

[hurkanpisirici]

Sayın ersoyalan ilginize çok teşekkür ederim buda çok güzel bir çalışma mutlaka işime yarayacak.ama tarih sorunum sürüyor tekrar teşekkürler arşivime ekledim.

 

[hurkanpisirici]

hocalarım bugün çok meşgul galiba.

 

[hurkanpisirici]

Gerçekten önemli benim için ilgilenecek bir hocam olursa çok sevineceğim.

 

[hurkanpisirici]

Bu kadar cevapsız kalacağımı düşünmemiştim, bu kodu yazmak zor galiba

 

[hurkanpisirici]

birde evden şansımı deniyim.

 

[hurkanpisirici]

hocalarımın yardımlarını bekliyorum.

 

[hurkanpisirici]

ümidimi yitirmeye başladım

 

[hurkanpisirici]

forumun en zor sorusumuydu acaba

 

[hurkanpisirici]

yardımlarınızı bekliyorum

 

[hurkanpisirici]

bu dosyaya yardım alabilirsem şirkette kullandığım dosyaya entegre edicem ve harika olacak.müsit olan bir hocam yokmu acaba

 

[janveljan]

Hürkan Bey verileri mükerrer olmayacak şekilde combolara aldırdım. Kodları aşağıda. Muhtemelen bu aşamadan sonra combolardaki verilere göre listboxı süzmek isteyeceksiniz, forumda bununla ilgili örnekler var, siz üzerinde çalışın yine yardımcı oluruz.
İyi çalışmalar.

Private Sub UserForm_Initialize()
On Error Resume Next
Dim tarih As New Collection
Dim firma As New Collection
For i = 2 To [B65536].End(3).Row
tarih.Add Format(Cells(i, 2), "dd.mm.yyyy"), CStr(Cells(i, 2))
firma.Add Cells(i, 3), CStr(Cells(i, 3))
Next
ComboBox4.AddItem "YAPILDI"
ComboBox4.AddItem "YAPILMADI"
For Each Item In tarih
ComboBox1.AddItem Item
ComboBox2.AddItem Item
Next
For Each Item In firma
ComboBox3.AddItem Item
Next

ListBox1.ColumnCount = 6
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "50;70;100;70;70;50;50;50"
ListBox1.RowSource = "sayfa1!a2:f" & Cells(65536, "a").End(3).Row
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

 

[hurkanpisirici]

sayın janveljan ilginize çok teşekkür ederim harika olmuş.Evet dediğiniz gibi bu dosyanın en büyük amacı combolar daki değerlere göre datalarımın gelmesi.elinize sağlık.

 

[hurkanpisirici]

sayın ayhan hocam mesajda bir problem oldu galibai gönderilmedi bir türlü.bu dosyada iki adet sorum vardı.Sağolsun janveljan hocam bir tanesini çok güzel bir şekilde halletmiş.İkinci sorunum hala sürmekte ama

 

[hurkanpisirici]

birde tabi yardım edeseniz hocam bu kodlar ile sizinkini aynı anda kullanabilirmiyim?

 

[janveljan]

Formun kodlarını aşağıdaki şekilkde değiştirin, süzme işlemini ekledim.

Private Sub ComboBox1_Change()
suz
End Sub
Private Sub ComboBox2_Change()
suz
End Sub
Private Sub ComboBox3_Change()
suz
End Sub
Private Sub ComboBox4_Change()
suz
End Sub

Private Sub UserForm_Initialize()
On Error Resume Next
Dim tarih As New Collection
Dim firma As New Collection
For i = 2 To [B65536].End(3).Row
tarih.Add Format(Cells(i, 2), "dd.mm.yyyy"), CStr(Cells(i, 2))
firma.Add Cells(i, 3), CStr(Cells(i, 3))
Next
ComboBox4.AddItem "YAPILDI"
ComboBox4.AddItem "YAPILMADI"
For Each Item In tarih
ComboBox1.AddItem Item
ComboBox2.AddItem Item
Next
For Each Item In firma
ComboBox3.AddItem Item
Next

ListBox1.ColumnCount = 6
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "50;70;100;70;70;50;50;50"
ListBox1.RowSource = "sayfa1!a2:f" & Cells(65536, "a").End(3).Row
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

Sub suz()
ReDim myarr(1 To 5, 1 To 1)
ListBox1.RowSource = ""
k = 0
For i = 2 To Cells(65536, "a").End(3).Row
    onay = True
    If ComboBox1.Value <> "" Then
        If Not DateValue(Cells(i, 2)) >= DateValue(ComboBox1.Value) Then onay = False
    End If
    If ComboBox2.Value <> "" Then
        If Not DateValue(Cells(i, 2)) <= DateValue(ComboBox2.Value) Then onay = False
    End If
    If ComboBox3.Value <> "" Then
        If Not Cells(i, 3) = ComboBox3.Value Then onay = False
    End If
    If ComboBox4.Value <> "" Then
        If Not Cells(i, 6) = ComboBox4.Value Then onay = False
    End If
    
    If onay Then
    k = k + 1
    ReDim Preserve myarr(1 To 5, 1 To k)
    
    myarr(1, k) = Cells(i, 1)
    myarr(2, k) = Cells(i, 3)
    myarr(3, k) = Cells(i, 4)
    myarr(4, k) = Cells(i, 5)
    myarr(5, k) = Cells(i, 6)
    End If
Next
ListBox1.Column = myarr
End Sub

 

[hurkanpisirici]

Sayın janveljan size nasıl teşekkür etsem az, o kadar hoşuma gittiki anlatamam ellerinize emeğinize sağlık,Allahrazı olsun çok teşekkür ederim.