Kapalı dosyadan listbox veri alma

[kemal turan]

Merhaba,
Ek te gönderdiğim dosyada dizi formülü ile aynı çalışma kitabı içerisinde olan cariler sayfasından listbox a veri filtreleme yapıyorum.
Aynı filtrelemeyi kapalı olan veri tabanı çalışma kitabından yapabilecek koda ihtiyacım var.
Teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Eski kodları silip yerine aşağıdaki kodalrı uygulayınız.

İki dosyanın aynı klasörde olduğu varsayılmıştır.

Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 4
    ListBox1.ColumnWidths = "42;132;96;96"
End Sub

Private Sub TextBox1_Change()
    Me.ListBox1.Clear
    Ara Me.TextBox1
End Sub

Sub Ara(Search_Data As Variant)
    Dim My_Connection As Object, My_Recordset As Object
    
    Application.ScreenUpdating = False
    
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
 
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\veritabanı.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No"""
     
    Set My_Recordset = My_Connection.Execute("Select * From [CARİLER$A2:D] Where F2 Like '%" & Search_Data & "%'")

    If Not My_Recordset.EOF Then ListBox1.Column = My_Recordset.GetRows

    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
  
    Set My_Connection = Nothing
    Set My_Recordset = Nothing

    Application.ScreenUpdating = True
End Sub

 

[kemal turan]

Çok teşekkür ederim Korhan hocam,
Bununla beraber hissiyatım olan bir konuyu açıklamak istiyorum.
Bir insan zengin ve müslüman ise zekat farz oluyor.
Para, altın ile beraber bilgi ve tecrübe de zenginliktir.
Bir insan da bildiği konuda bildiklerini ve tecrübelerini paylaşıyorsa bilgisinin zekatını vermiş oluyor.
Ben buna inanıyorum.
Ne mutlu (excel.web.tr ustalarına) zekatını verenlere...
Selametle kalınız.

 

[kemal turan]

Korhan bey,
Aranacak değer asıl dosyamda 3 ncü sutunda olması nedeniyle "Where F2 Like" satırını "Where F3 Like" yaparak çözdüm.
kendi dosyası olduğunda normal arama kodunda istediğim kritere bağlı arama yapabiliyordum. Bu bağlantı filtreleme kodunda
Herhalde ek dosyada A sutunundaki kritere bağlı arama yapmak istediğimde aşağıdaki kod satırında bir ekleme lazım.
Set My_Recordset = My_Connection.Execute("Select * From [CARİLER$A2] Where F2 Like '%" & Search_Data & "%'")
Ek dosyada option buttonlu bir form hazırladım. OptionButton caption a göre yardımcı olabilirseniz sevinirim.
Teşekkür ederim

 

[Korhan Ayhan]

Deneyiniz.

Private Sub OptionButton1_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton10_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton11_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton12_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton13_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton2_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton3_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton4_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton5_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton6_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton7_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton8_Click()
    Ara Me.TextBox1
End Sub

Private Sub OptionButton9_Click()
    Ara Me.TextBox1
End Sub

Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 5
    ListBox1.ColumnWidths = "70;70;196;70;70"
End Sub

Private Sub TextBox1_Change()
    TextBox1 = Evaluate("=UPPER(""" & TextBox1 & """)")
    Me.ListBox1.Clear
    Ara Me.TextBox1
End Sub

Sub Ara(Search_Data As Variant)
    Dim My_Connection As Object, My_Recordset As Object, X As Byte, Kota_Grubu As String
    
    Application.ScreenUpdating = False
    
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
 
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\VERITABANI.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No"""
     
    For X = 1 To 13
        If Me.Controls("OptionButton" & X) = True Then
            Kota_Grubu = Me.Controls("OptionButton" & X).Caption
            Exit For
        End If
    Next
     
    If Kota_Grubu = "" Then
        Set My_Recordset = My_Connection.Execute("Select * From [URUNLER$A2:E] Where F3 Like '%" & Search_Data & "%'")
    Else
        Set My_Recordset = My_Connection.Execute("Select * From [URUNLER$A2:E] Where F1 = '" & Kota_Grubu & "' And F3 Like '%" & Search_Data & "%'")
    End If

    If Not My_Recordset.EOF Then ListBox1.Column = My_Recordset.GetRows

    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
  
    Set My_Connection = Nothing
    Set My_Recordset = Nothing

    Application.ScreenUpdating = True
End Sub

 

[kemal turan]

Korhan hocam teşekkür ederim.
Bende grupları farklı sayfalara alarak bir çözüm bulmuştum .
çözüm dosyasını ekleyemedim. dosya ekle ikonu yok neden acaba
Selametle

 

[kemal turan]

On yılı dordurmuşuz.
yeni bir on yıl başladı..
Açılacak userform YENISATISFORMU

 

[kemal turan]

Korhan hocam,
Yukarıdaki filtreleme kodunda şöyle bir sıkıntı oluştu,
Bu kodu ağda 4 bilgisayar kullanıyorum. Bu ana kadar sıkıntı yoktu. İşte yoğunluk olup 2 bilgisayar aynı anda
change olayı ile filtreleme yaptığında veri alınan xlsx dosyası açık kalıyor.
Dolayısı ile fitrelenen veri çift tıklama ile kendi kullanıcı sahifesine gönderilemiyor." Sayfa bulunamadı" hatası veriyor.
BU cevabı seyahat halinde iken yazdığımdan dolayı düşüncemi uygulayamıyorum .
Acaba;
Filtrelemeyi change olayı ile değilde textbox un exit olayına bağlasam sorun çözülür mü.
Veya farklı bir çözüm olabilir mi.
Teşekkür ederim.

 

[Korhan Ayhan]

Çoklu kullanıcı ile hiç denemem olmadı.

Excel sanırım bu duruma çok müsait değil.

Belki şöyle bir uygulama yapabilirsiniz. Bir kullanıcı dosyada çalışırken ikinci bir kişi açmaya çalıştığında uyarı verdirip daha sonra dosyayı kullanmasını sağlayabilirsiniz.

Ya da bu konuda tecrübesi olan arkadaşlar yönlendirme yapabilirler.