Combobox Filitreleme

umit1907

Altın Üye
Katılım
9 Mayıs 2007
Mesajlar
224
Excel Vers. ve Dili
365 TR
Altın Üyelik Bitiş Tarihi
18-04-2029
Merhabalar,
Combobox'ta 2 sutunum var bunun içerisinde arama yapmak istiyorum yardımcı olabilirmisiniz.
 

Ekli dosyalar

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 kodlarını aşağıdakilerle değiştirip dener misiniz?

PHP:
Private Sub cboPart_Change()
Dim cPart As Range
Dim cLoc As Range
Dim ws As Worksheet
Set ws = Worksheets("tbl_FislerDetay")
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 Hesap, HesapAdi from [tbl_FislerDetay$] where Hesap like '%" & cboPart.Text & "%' or HesapAdi like '%" & cboPart.Text & "%'"
Set rs = con.Execute(sorgu)

cboPart.Column = rs.getrows

End Sub

Private Sub cboPart_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ActiveSheet.Range("E1").Value = cboPart.Text
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If UserForm1.TextBox1 <> "" Then
    If Len(TextBox1) < 8 Then
        MsgBox "Eksik Rakam Girdiniz!.", vbExclamation
    Else
        TextBox1 = Format(TextBox1, "0#"".""##"".""####")
    End If
End If
ActiveSheet.Range("E3").Value = TextBox1.Text

End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If UserForm1.TextBox2 <> "" Then
        If Len(TextBox2) < 8 Then
            MsgBox "Eksik Rakam Girdiniz!.", vbExclamation
        Else
            TextBox2 = Format(TextBox2, "0#"".""##"".""####")
        End If
    End If
ActiveSheet.Range("E4").Value = TextBox2.Text
End Sub

Private Sub UserForm_Initialize()
Dim cPart As Range
Dim cLoc As Range
Dim ws As Worksheet
Set ws = Worksheets("tbl_FislerDetay")
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 Hesap, HesapAdi from [tbl_FislerDetay$] where Hesap is not null"
Set rs = con.Execute(sorgu)

cboPart.Column = rs.getrows
End Sub
 

umit1907

Altın Üye
Katılım
9 Mayıs 2007
Mesajlar
224
Excel Vers. ve Dili
365 TR
Altın Üyelik Bitiş Tarihi
18-04-2029
Çok teşekkürler elinize sağlık.
 
Üst