• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

userform açılırken listbox1 e dizi yapısı ile veri yükle

Ş

şehiriçi

Katılım
1 Ağustos 2013
Mesajlar
563
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Merhaba Dostlar,
Vba diziler konusunda zorluk çeken biriyim . Hazırladığım excel dosyasında userformu çağırınca hububat_alis sayfasındaki verilerin listbox1 e dizi yöntemi ile yüklenmesini istiyorum , desteğinizi bekliyorum , teşekkürler .
 

Ekli dosyalar

Merhaba.

Daha kolay bir yöntem varken neden dizi kullanmak istiyorsunuz?
Dosyanızdaki UserForm_Initialize kodlarını silin aşağıdakileri kopyalayın.

Kod: 
Private Sub UserForm_Initialize()
    Dim SonSat As Integer
    SonSat = Sheets("hububat_alis").Cells(Rows.Count, "A").End(xlUp).Row
    ListBox1.ColumnCount = 5 '5 kolonlu Listbox
    ListBox1.ColumnHeads = True 'Başlıklar eklensin
    ListBox1.RowSource = Sheets("hububat_alis").Range("A2:E" & SonSat).Address
End Sub
 
Evet Doğrusunuz... hiç bilenle bilmeyen bir olurmu ? tabi benim hedefim sadece listboxı yazdırmak değil
combobox2 de işaretlediğim verinin yine listbox1 de süzülerek kaç adet varsa listelemesini sağlamak ve ardından da listboxa tıklayınca verinin olduğu satırı göstermek
Şimdi sizin verdiğiniz kodu dosyama reize ederken güncellenmiş dosyamı ekliyorum , teşekkürler Adaşım...
Bu arada listboxta süzmeyi de comboboxta veriyi bulup süz butonu ile yaptım.
Sizden mümkünse listbox1 e tıklayınca , tıklanan veriyi excelde bulup bulduğu satırı renklendirmesi , teşekkürler
 

Ekli dosyalar

Öncelikle Süz düğmesi kullanmadan doğrudan combobox değişikliğinde süzme işlemi yapması için Süz düğmesindeki kodları combobx2'nin Change kodlarına eklemelisiniz:

Kod: 
Private Sub ComboBox2_Change()
Dim isim As Variant
Dim liste As Long
Dim mz As Long
ListBox1.RowSource = Empty
ListBox1.Clear
ListBox1.ColumnCount = 5
mz = Sheets("hububat_alis").Cells(Rows.Count, "a").End(xlUp).Row

For Each isim In Sheets("hububat_alis").Range("a2:a" & mz)
    If UCase(LCase(isim)) Like UCase(LCase(ComboBox2)) & "*" Then
        liste = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(liste, 0) = isim.Row
        ListBox1.List(liste, 1) = isim 'isim
        ListBox1.List(liste, 2) = isim.Offset(0, 1) 'tarih
        ListBox1.List(liste, 3) = isim.Offset(0, 2) 'hb çeşidi
        ListBox1.List(liste, 4) = isim.Offset(0, 3) 'kğ
        ListBox1.List(liste, 5) = isim.Offset(0, 4) 'f
    End If
Next
End Sub

Listbox'ta seçilen satırın renklenmesi için de aşağıdaki kodları eklemelisiniz:

PHP: 
Private Sub ListBox1_Change()
Dim s1 As Worksheet
Dim sat As Integer
Dim son As Integer
Dim i As Integer
Set s1 = Sheets("hububat_alis")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:E" & son).Interior.Color = xlNone
If ComboBox2 <> "" Then
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sat = ListBox1.List(i, 0)
        End If
    Next
Else
    sat = ListBox1.ListIndex + 2
End If
s1.Range("A" & sat & ":E" & sat).Interior.Color = vbYellow
End Sub
 
yusuf44 teşekkürler , verdiğiniz kodu dosyama revize ettim . Ancak şöyle bir sıkıntım var . Gerçek dosyamda sütun sayısı daha fazla ve ben userformu çağırdığımda listbox1 e yapılan eklemelerde sadece istediğim sütunları getirmek istiyorum . Eğer mümkünse Örnek dosyamda sütun sayısını artırdım ve userformu çağırdığımda Excel de şu sütunları görmek istiyorum ..A_B_D_E_H_I_J_K_N_O_P .Desteğiniz için şimdiden teşekkürler.
 

Ekli dosyalar

Initialize kodlarını aşağıdakiyle değiştirince not sütunu hariç diğer sütunları listeliyor ama not sütununu da ekleyince kodlar söz dizimi hatası veriyor, nedenini çözemedim:

PHP: 
Private Sub UserForm_Initialize()
Dim sonhb, sonV, i, h As Long, s1 As Worksheet, son As Integer, con, sorgu, rs

sonV = Sheets("veri").Cells(Rows.Count, "A").End(xlUp).Row
sonhb = Sheets("hububat_alis").Cells(Rows.Count, "A").End(xlUp).Row

ComboBox1.RowSource = "veri!A2:A" & sonV
ComboBox2.RowSource = "hububat_alis!A2:A" & sonhb

Set s1 = Sheets("hububat_alis")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select İsim,Tarih,Çeşit,Kğ,f,Tescil,T_İsmi,Tutar,Bakiye,G_Bakiye from [hububat_alis$] where İsim is not null"
Set rs = con.Execute(sorgu)

ListBox1.ColumnCount = 11 '11 kolonlu Listbox
ListBox1.ColumnHeads = True 'Başlıklar eklensin
ListBox1.Column = rs.getrows
End Sub

not sütununu da eklemek için kullandığım satır şöyleydi ama dediğim gibi çalıştıramadım:

sorgu = "select İsim,Tarih,Çeşit,Kğ,f,Tescil,T_İsmi,Tutar,Bakiye,G_Bakiye,not from [hububat_alis$] where İsim is not null"
 
yusuf bey hata veriyor özellikle ,
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select İsim,Tarih,Çeşit,Kğ,f,Tescil,T_İsmi,Tutar,Bakiye,G_Bakiye from [hububat_alis$] where İsim is not null"
Set rs = con.Execute(sorgu)
yukarıdaki kodu anlayamadım ..vba değilmi yoksa ben yeterince incelemeden mi cevap verdim ama listboxa tıklayınca hata veriyor .
not sütununa gelince aslında onu bende fark etmiştim özellikle 11 sütun yaptım ki siz veya değerli dostlarımızdan bir çözüm gelsin diye çünki benim sütun sayım gerçekte 18 tane ...
ListBox1.ColumnHeads = True 'Başlıklar eklensin...birde başlıklarda görünmüyor neden?
 

Ekli dosyalar

Hatanın sebebi sanıyorum kodları Listbox1'in change olayına yazmamız. DbClick olayına yazınca düzeliyor. Listbox1'in change kodlarını tamamen silin ve aşağıdaki kdoları ekleyip deneyin. Listboxtan seçim yaptığınızda renklenmesi için listboxa çift tıklamanız gerekir:

PHP: 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim s1 As Worksheet
Dim sat As Integer
Dim son As Integer
Dim i As Integer
If ListBox1.Value = "" Then
    s1.Range("A1:P" & son).Interior.Color = xlNone
    Exit Sub
End If
Set s1 = Sheets("hububat_alis")
son = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("A1:P" & son).Interior.Color = xlNone
If ComboBox2.ListIndex > -1 Then
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sat = ListBox1.List(i, 0)
        End If
    Next
Else
    sat = ListBox1.ListIndex + 2
End If
s1.Range("A" & sat & ":P" & sat).Interior.Color = vbYellow
End Sub

Belirttiğiniz bölüm hızlıca veri listelemeye yarayan ADO-SQL kodları. Bir veritabanından hızlıca sonuç almak için kullanılıyor. Başlıkların gelmemesi de rowsource terine sql ado kullanmamızdan kaynaklanıyor muhtemelen.

not olayını maalesef çözemiyorum.
 
not olayını anladım galiba.

Bildiğimiz gibi not, İngilizcede "Değil" anlamına gelmektedir ve VBA'da da "not" olarak kullanılan bir komuttur. VBA'da olan bir komut olduğu için sütun başlığı olarak kabul edilmiyor. Çükü kodlar ordaki not ifadesini başlık olarak kabul etmiyor "değil" ifadesi olarak kabul ediyor.

not yerine başka bir kelime yazarak sorunu çözebiliriz, mesela "açıklama" gibi.
 
@YUSUF44,

not ifadesini köşeli parantez içinde yazmayı deneyiniz.

"Select [not] From [Sayfa1$]"
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst