bağlantılı süzmek

[CILEKESH]

Private Sub ComboBox1_Change()
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 7, 1 To 1)
With Worksheets("DURUM")
    Me.ListBox5.RowSource = vbNullString
    'Show all records of Database on Sheet1
    If .FilterMode Then .ShowAllData
    Set k = .Range("A2:A65536").Find(ComboBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 7, 1 To a)
            For j = 1 To 7
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = .Range("A2:A65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox5.Column = myarr
    End If
End With
Sheets("DURUM").TextBox6.Value = Me.ComboBox1.Value
End Sub

ve

Private Sub ComboBox4_Change()
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 7, 1 To 1)
With Worksheets("DURUM")
    Me.ListBox5.RowSource = vbNullString
    'Show all records of Database on Sheet1
    If .FilterMode Then .ShowAllData
    Set k = .Range("E2:E65536").Find(ComboBox4.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 7, 1 To a)
            For j = 1 To 7
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = .Range("E2:E65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox5.Column = myarr
    End If
End With
Sheets("DURUM").TextBox2.Value = Me.ComboBox4.Value
End Sub

Yukarıdaki kodlar ile listboxda süzme işlemi gerçekleştiriyorum. Bunları birbirine bağlantılı olarak değiştirebilir miyiz? Başka kod mu lazım?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki linkte benzer bir soruyu yanıtlamıştım. İncelermisiniz.

Formda 3 Combobox ile süzme

 

[CILEKESH]

Merhaba,

Aşağıdaki linkte benzer bir soruyu yanıtlamıştım. İncelermisiniz.

Formda 3 Combobox ile süzme

Kodları çalışmama uyguladım ama yapamadım. Dosyamı ekledim "DURUM" Userformuna (Userform3) yapmaya çalışıyorum

 

[CILEKESH]

Excel' e geçmek için Kasa butonunu Kullanınız o buton Excel'e dönüyor.

 

[Korhan Ayhan]

Merhaba,

Dosyanızda gerekli düzenlemeleri yaptım. İncelermisiniz.

 

[CILEKESH]

Emeğinize sağlık. Listboxda süzme tam istediğim gibi ancak,
Formdaki combolarda seçilen değerler excel sayfasını texler vasıtasıyla süzüyor ve yazdır butonuylada excelde süzülmüş sayfa yazdırılıyor.

Şu anki durumda combolara yazılan değerler texlere aktarılıyor ama exceli süzmüyor.!!!!!
Exceldeki texlere manuel yazarsan oluyor ama kullanıcının bu formda excele geçmemesi gerekiyor
Bunuda düzeltebilirmisiniz?

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımdaki dosyayı yeniledim. Denermisiniz.

 

[CILEKESH]

Çok güzel. Fikrinize sağlık. En büyük sorunumu çözdünüz.

 

[CILEKESH]

Çok güzel. Fikrinize sağlık. En büyük sorunumu çözdünüz.

Korhan bey Aynı sayfa ile ilgili bir sorunum daha var.

Bu ay dahil
Bu ay hariç isimli iki adet optionbutton var "durum" formunda. Bu butonlar Exceldeki ilgili yerin tarihini değiştiriyor. şu an bu butonlarda bu kodlar yazılı..

Ancak bu kodlar işlem yaptıktan sonra Süzme işlemi bozulmadan Listbox'ın güncellenmesi gerekiyor. Çok uğraşmama rağmen yaptıramadım.

Ayrıca "DURUM" userformundan her çıkış yapıldığında da Bu ay dahil butonundaki kod çalışması lazım. (Bunu userform üzerindeki bütün butonlara ilgili kodu yazarak sağladım ama pek sağlıklı olmadı gibime geliyor. Tek kodla yazabilirmiyiz.

Dosyamda güncelleme mevcut olduğundan bu mesajda eklediğim dosyamda çalışırsanız sevinirim.

 

[Korhan Ayhan]

Merhaba,

İkinci sorunuz için bahsettiğiniz eklemeleri silin ve aşağıdaki prosedüre kırmızı eklemeyi yapın.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
[COLOR=red]    Sheets("TAHAKKUKLAR").Range("A1") = "=TODAY()"[/COLOR]
    Kontrol = False
End Sub

İlk sorunuz içinde ilgili nesnelere ait kodları aşağıdaki şekilde değitirin.

Private Sub OptionButton1_Click()
    Sheets("TAHAKKUKLAR").Range("A1") = "=TODAY()"
    ComboBox1_Change
    ComboBox2_Change
    ComboBox3_Change
    ComboBox4_Change
End Sub
 
Private Sub OptionButton2_Click()
    Sheets("TAHAKKUKLAR").Range("A1") = "='Hesap Özeti'!E4"
    ComboBox1_Change
    ComboBox2_Change
    ComboBox3_Change
    ComboBox4_Change
End Sub

 

[CILEKESH]

Çözümlendi. Teşekkür ederim.