UserForm'da Combobox ile filtre yapma

ruzzher

Altın Üye
Katılım
1 Şubat 2022
Mesajlar
32
Excel Vers. ve Dili
Excel 2019 ve 2016
Altın Üyelik Bitiş Tarihi
07-03-2028
Merhabalar
Excel dosyada 2 adet sayfa bulunmaktadır. 1.sayfa kullanılan olan ana ekrandır. 2.sayfa ise verilerin tutuldu yer olacak.

1.sayfa yani anasayfa bir adet commandbutton bulunmakta. Butona bastığınız ekran user form geliyor.

Userform'da bir adet combobox ve listbox bulunmakta.

Combobox'ta 2.sayfa yer alan verilerden bölge yani C sütundaki veriler yer alacak.

Combobox seçtiğimiz bölge göre listbox'ta listelenecek.

Örnek Dosya:
https://s2.dosya.tc/server17/65rnxi/Kitap1.xltm.html
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları userformun kod bölümüne ekleyip deneyin:

PHP:
Private Sub ComboBox1_Change()
Set s1 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 * from [Sayfa2$] where BÖLGE='" & ComboBox1.Value & "'"
Set rs = con.Execute(sorgu)
If Not rs.EOF Then
    ListBox1.Column = rs.getrows
End If
End Sub

Private Sub UserForm_Initialize()
Set s1 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 distinct BÖLGE from [Sayfa2$] where BÖLGE is not null"
Set rs = con.Execute(sorgu)

ComboBox1.Column = rs.getrows
ListBox1.ColumnCount = 5
End Sub
 

ruzzher

Altın Üye
Katılım
1 Şubat 2022
Mesajlar
32
Excel Vers. ve Dili
Excel 2019 ve 2016
Altın Üyelik Bitiş Tarihi
07-03-2028
Private Sub ComboBox1_Change() Set s1 = Sheets("Sayfa2") son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 * from [Sayfa2$] where BÖLGE='" & ComboBox1.Value & "'" Set rs = con.Execute(sorgu) If Not rs.EOF Then ListBox1.Column = rs.getrows End If End Sub Private Sub UserForm_Initialize() Set s1 = Sheets("Sayfa2") son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 distinct BÖLGE from [Sayfa2$] where BÖLGE is not null" Set rs = con.Execute(sorgu) ComboBox1.Column = rs.getrows ListBox1.ColumnCount = 5 End Sub


Code buna çevirdim ve böyle hata verdi

Kod:
Private Sub ComboBox1_Change()
Set s1 = Sheets("ALL_DATA")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "C").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 * from [ALL_DATA$] where BÖLGE='" & ComboBox1.Value & "'"
Set rs = con.Execute(sorgu)
If Not rs.EOF Then
    ListBox1.Column = rs.getrows
End If
End Sub

Private Sub UserForm_Initialize()
Set s1 = Sheets("ALL_DATA")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "C").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 distinct BÖLGE from [ALL_DATA$] where BÖLGE is not null"
Set rs = con.Execute(sorgu)

ComboBox1.Column = rs.getrows
ListBox1.ColumnCount = 5
End Sub
 

ruzzher

Altın Üye
Katılım
1 Şubat 2022
Mesajlar
32
Excel Vers. ve Dili
Excel 2019 ve 2016
Altın Üyelik Bitiş Tarihi
07-03-2028
Birde başlıklarını yani header almıyor
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Dosyanızı o haliyle paylaşırsanız iyi olur. (Dosyanızda All_Data sayfası var mı?)

Başlıkların listbota görünmesi için userforma Labeller ekleyip başlık olarak onları kullanmanızı öneririm.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,267
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Hata mesajı ile ilgili linki inceleyiniz.

 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,267
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ben sorguda Tablo olarak kullandığınızı düşündüğüm için linki paylaştım. Fakat sizin sorun sanırım daha farklı. Bu sebeple bir önceki mesajımı görmezden gelebilirsiniz.
 

ruzzher

Altın Üye
Katılım
1 Şubat 2022
Mesajlar
32
Excel Vers. ve Dili
Excel 2019 ve 2016
Altın Üyelik Bitiş Tarihi
07-03-2028
Dosyanızı o haliyle paylaşırsanız iyi olur. (Dosyanızda All_Data sayfası var mı?)

Başlıkların listbota görünmesi için userforma Labeller ekleyip başlık olarak onları kullanmanızı öneririm.
combobox'a tümünü göster ekleyebilir miyiz?
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Neyin tümünü göstermek istiyorsunuz?
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Doğru anladıysam kodları aşağıdakilerle değiştirip deneyin:

PHP:
Private Sub ComboBox1_Change()
Set s1 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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"""

If ComboBox1.Value = "Tümünü Göster" Then
    sorgu = "select * from [Sayfa2$] where BÖLGE is not null"
Else
    sorgu = "select * from [Sayfa2$] where BÖLGE='" & ComboBox1.Value & "'"
End If
Set rs = con.Execute(sorgu)
If Not rs.EOF Then
    ListBox1.Column = rs.getrows
End If
End Sub

Private Sub UserForm_Initialize()
Set s1 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 distinct BÖLGE from [Sayfa2$] where BÖLGE is not null"
Set rs = con.Execute(sorgu)

ComboBox1.Column = rs.getrows
ComboBox1.AddItem

For i = ComboBox1.ListCount - 1 To 1 Step -1
    ComboBox1.List(i) = ComboBox1.List(i - 1)
Next
ComboBox1.List(0) = "Tümünü Göster"
ListBox1.ColumnCount = 5
End Sub
 

ruzzher

Altın Üye
Katılım
1 Şubat 2022
Mesajlar
32
Excel Vers. ve Dili
Excel 2019 ve 2016
Altın Üyelik Bitiş Tarihi
07-03-2028
Doğru anladıysam kodları aşağıdakilerle değiştirip deneyin:

PHP:
Private Sub ComboBox1_Change()
Set s1 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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"""

If ComboBox1.Value = "Tümünü Göster" Then
    sorgu = "select * from [Sayfa2$] where BÖLGE is not null"
Else
    sorgu = "select * from [Sayfa2$] where BÖLGE='" & ComboBox1.Value & "'"
End If
Set rs = con.Execute(sorgu)
If Not rs.EOF Then
    ListBox1.Column = rs.getrows
End If
End Sub

Private Sub UserForm_Initialize()
Set s1 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 distinct BÖLGE from [Sayfa2$] where BÖLGE is not null"
Set rs = con.Execute(sorgu)

ComboBox1.Column = rs.getrows
ComboBox1.AddItem

For i = ComboBox1.ListCount - 1 To 1 Step -1
    ComboBox1.List(i) = ComboBox1.List(i - 1)
Next
ComboBox1.List(0) = "Tümünü Göster"
ListBox1.ColumnCount = 5
End Sub
userform açıldığında tümünü göster seçili olarak gelsin nasıl yapılır?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,267
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Private Sub ComboBox1_Change()
    Set s1 = Sheets("Sayfa2")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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"""
    
    If ComboBox1.Value = "Tümünü Göster" Then
        sorgu = "select * from [Sayfa2$] where BÖLGE is not null"
    Else
        sorgu = "select * from [Sayfa2$] where BÖLGE='" & ComboBox1.Value & "'"
    End If
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        ListBox1.Column = rs.getrows
    End If
End Sub

Private Sub UserForm_Initialize()
    Set s1 = Sheets("Sayfa2")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 distinct BÖLGE from [Sayfa2$] where BÖLGE is not null"
    Set rs = con.Execute(sorgu)
    
    Liste_1 = Array("Tümünü Göster")
    Liste_2 = Application.Transpose(Application.Transpose(rs.getrows))
    
    Liste = Split(Join(Liste_1, ",") & "," & Join(Liste_2, ","), ",")
    
    ComboBox1.List = Liste
    ComboBox1.ListIndex = 0
    
    ListBox1.ColumnCount = 5
End Sub
 

ruzzher

Altın Üye
Katılım
1 Şubat 2022
Mesajlar
32
Excel Vers. ve Dili
Excel 2019 ve 2016
Altın Üyelik Bitiş Tarihi
07-03-2028
Deneyiniz.

C++:
Private Sub ComboBox1_Change()
    Set s1 = Sheets("Sayfa2")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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"""
   
    If ComboBox1.Value = "Tümünü Göster" Then
        sorgu = "select * from [Sayfa2$] where BÖLGE is not null"
    Else
        sorgu = "select * from [Sayfa2$] where BÖLGE='" & ComboBox1.Value & "'"
    End If
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        ListBox1.Column = rs.getrows
    End If
End Sub

Private Sub UserForm_Initialize()
    Set s1 = Sheets("Sayfa2")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 distinct BÖLGE from [Sayfa2$] where BÖLGE is not null"
    Set rs = con.Execute(sorgu)
   
    Liste_1 = Array("Tümünü Göster")
    Liste_2 = Application.Transpose(Application.Transpose(rs.getrows))
   
    Liste = Split(Join(Liste_1, ",") & "," & Join(Liste_2, ","), ",")
   
    ComboBox1.List = Liste
    ComboBox1.ListIndex = 0
   
    ListBox1.ColumnCount = 5
End Sub
Hatalı çalışmıyor
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
userform açıldığında tümünü göster seçili olarak gelsin nasıl yapılır?
Inıtialize kısmında End Sub satırından önce aşağıdaki satırı ekleyin:

ComboBox1.ListIndex = 0

Bu arada sayın @Korhan Ayhan 'ın kodlarını da denedim, düzgün çalışıyor. "Hatalı çalışmıyor" demek yerine ne gibi bir hata verdiğini ya da örnek dosyanızı hatalı haliyle paylaşmanızı öneririm.
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
03.11.2024
Korhan hocam combobox ile etkileşimli 2 listbox ile iki tarih arası sorgu aynı yöntemle çalıştırılabilirmi.
Tarih sorgusu yapacağım yada sadece comboboxtan sorgu yapılacak. Biraz uğraştım ama tarih sorgusu kısmında hata alıyorum.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,267
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Burhan Bey,

Veriler ve istekler mantıklı olduğu sürece birçok şey yapılabilir.. Göremediğimiz bir tablo hakkında çokta fazla yorum yapamıyorum.
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
03.11.2024
Korhan hocam Merhaba
Sizin daha önceki bir örneğinizden yararlanarak yanlızca combobx ile verileri listbox a alabiliyorum. İki tarih arası sorgulara örnekteki gibi kodları eklediğimde sözdizimi hatası alıyorum. Sorguları doğru yapamıyorum sanırım. Yönlendirebilirseniz memnun olurum.

Kod:
Private Sub ComboBox1_Change()
    Set s1 = Sheets("EPDK_Veritabanı")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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"""
   
    If ComboBox1.Value = "Tümünü Göster" Then
        sorgu = "select * from [EPDK_Veritabanı$] where Yakit_Tipi is not null"
    Else
        sorgu = "select * from [EPDK_Veritabanı$] where Yakit_Tipi='" & ComboBox1.Value & "'"
    End If
   
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        ListBox1.Column = rs.getrows
    End If
End Sub
Kod:
Private Sub TextBox2_Change()
    Set s1 = Sheets("EPDK_Veritabanı")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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"""

    If ComboBox1.Value = "" Then
        sorgu = "select * from [EPDK_Veritabanı$] where Tarih is not null"
    Else
        sorgu = "select * from [EPDK_Veritabanı$] where Tarih=>'" & TextBox1.Value & "'"
    End If

    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        ListBox1.Column = rs.getrows
    End If
End Sub
Kod:
Private Sub TextBox3_Change()
    Set s1 = Sheets("EPDK_Veritabanı")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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"""

    If ComboBox1.Value = "" Then
        sorgu = "select * from [EPDK_Veritabanı$] where Tarih is not null"
    Else
        sorgu = "select * from [EPDK_Veritabanı$] where Tarih<='" & TextBox3.Value & "'"
    End If

    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        ListBox1.Column = rs.getrows
    End If
End Sub
Kod:
Private Sub UserForm_Initialize()

    Set s1 = Sheets("EPDK_Veritabanı")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").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 distinct Yakit_Tipi from [EPDK_Veritabanı$] where [Tarih] is not null
    Set rs = con.Execute(sorgu)

    Liste_1 = Array("Tümünü Göster")
    Liste_2 = Application.Transpose(Application.Transpose(rs.getrows))
    Liste = Split(Join(Liste_1, ",") & "," & Join(Liste_2, ","), ",")

    ComboBox1.List = Liste
    ComboBox1.ListIndex = 0

    ListBox1.ColumnCount = 11
    ListBox1.ColumnWidths = "50;70;170;80;50;80;30;80;0;0;80"

End Sub
 
Üst