Veri Almak, Seçime Göre Sayfadan UserForm'lara

[1Al2Ver]

Merhaba,

Oluşturduğum UserForm'da ;

1 ad.Label ve 2 ad.ListBox var,

Mevcut kod ile ;

ListBox1'e, sayfadaki "K2:L30" aralığını,

ListBox2'ye yemeklerin tamamını, alıyorum,

İSTENEN ;

ListBox1' den bir grup seçtiğimde,

1) Seçilen grup Label7' de görülsün,

2) Seçilen gruba ait yemekler de ListBox2'ye sıralansın,

3) ListBox2'deki Toplam Sütunu Kalın ve Kırmızı renk olsun, istiyorum,

***ListBox2'nin görünür kapasitesi 50 yemekliktir.

Teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Deneyiniz.

Listbox nesnesi sütun ya da satır bazında renklenemez, bold yapılamaz. Yapacağınız biçimlendirme nesneyi tümüyle etkileyecektir.

Option Explicit

Private Sub ListBox1_Click()
    Dim S1 As Worksheet, Baglanti As Object, Kayit_Seti As Object, Dosya As String, Sorgu As String

    ListBox2.RowSource = ""
    Label7.Caption = IIf(ListBox1.Value = "", "GRUP", "GRUP - " & ListBox1.Value)
    
    If ListBox1.Value = "" Then
        Exit Sub
    End If

    Set S1 = Sheets("TÜM_AY")
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")

    Dosya = ThisWorkbook.FullName

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""

    Sorgu = "Select F2,F3,F4,F5,F6,F7,F8 From [" & S1.Name & "$B2:I] Where F1 = '" & ListBox1.Value & "'"

    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    If Kayit_Seti.RecordCount > 0 Then
        ListBox2.Column = Kayit_Seti.GetRows
    End If
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close

    Set S1 = Nothing
    Set Baglanti = Nothing
    Set Kayit_Seti = Nothing
End Sub

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Çözüm ve bilgilendirme için teşekkür ederim, sağ olun, her şey gönlünüzce olsun.

Saygılarımla.

 

[Korhan Ayhan]

Üstteki mesajımda ki kodda küçük düzeltmeler yaptım. (Boş satırlarla ilgili olarak)

Ek olarak aşağıdaki kodlar hız olarak biraz daha iyi performans veriyor. Dilediğinizi kullanırsınız.

Option Explicit

Private Sub ListBox1_Click()
    Dim S1 As Worksheet, Veri As Variant
    Dim Son As Long, X As Long, Y As Byte, Say As Long

    ListBox2.RowSource = ""
    Label7.Caption = IIf(ListBox1.Value = "", "GRUP", "GRUP - " & ListBox1.Value)

    If ListBox1.Value = "" Then
        Exit Sub
    End If

    Set S1 = Sheets("TÜM_AY")

    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    Veri = S1.Range("A2:I" & Son).Value

    ReDim Liste(1 To 7, 1 To 1)

    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 2) <> "" Then
            If Veri(X, 2) = ListBox1.Value Then
                Say = Say + 1
                ReDim Preserve Liste(1 To 7, 1 To Say)
                For Y = 1 To 7
                    Liste(Y, Say) = Veri(X, Y + 2)
                Next
            End If
        End If
    Next

    If Say > 0 Then
        ListBox2.Column = Liste
    End If

    Set S1 = Nothing
End Sub

 

[1Al2Ver]

Sayın Korhan Ayhan, tekrar merhaba,

Hassasiyetiniz ve ilginiz için çok teşekkür ederim,

Saygılarımla.