Combobox ile çoklu koşula göre veri sıralama

[Believing]

Sayın uzman arkadaşlar,

Ekteki çalışmanın "ÖZET" isimli sayfasına iki adet Combobox atayarak veri filtrelemesi yapmak istiyorum. Buna Göre;
"ÖZET" sayfasındaki veriler "VERİTABANI" isimli sayfadan formül yardımı ile alınmaktadır.
"Combobox1" ile Büyükten_Küçüğe veya Küçükten_Büyüğe seklinden seçim yapılacaktır.
"Combobox2" ile 4 adet sütun başlığına göre seçim yapılacaktır.
Her iki Combobox seçimine göre ilk 15'e giren veriler listelenmelidir.
Konuya hakim veya uzman arkadaşların çok değerli yardımlarını rica ediyorum,

Saygılarımla.

Örnek Çalışma Linki;

Veri_Siralama.xlsm dosyasını indir - download

Veri_Siralama.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[Ömer]

Merhaba,

Özet sayfasının kod bölümüne yazarak deneyiniz.

Sub Listele()

    Dim Sv As Worksheet, son As Long, sutun As Integer, sirala
    
    Set Sv = Sheets("VERİTABANI")
    son = Sv.Cells(Rows.Count, "A").End(xlUp).Row
    sutun = ComboBox2.ListIndex + 29
    sirala = xlAscending
    
    If ComboBox1.Value = "Büyükten_Küçüğe" Then sirala = xlDescending
    
    Application.ScreenUpdating = False
    Range("AA6:AF" & Rows.Count).Clear
    
    Sv.Range("A3:D" & son).Copy Range("AA6")
    
    Range("AE6").Resize(son - 2, 1).FormulaLocal = "=EĞERHATA(AD6/AC6;0)"
    Range("AF6").Resize(son - 2, 1).FormulaLocal = "=EĞERHATA(AD6/$AD$4;0)"
    
    Range("AD:AD").Copy
    Range("AE:AF").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    
    Range("AE:AF").NumberFormat = "0.00%"
    
    Range("AA6:AF" & Rows.Count).Sort Cells(5, sutun), sirala
    Range("AA4").Select
    
    Range("AA21:AF" & Rows.Count).Clear
    
End Sub

Private Sub ComboBox1_Change()
    Listele
End Sub

Private Sub ComboBox2_Change()
    Listele
End Sub

 

[Believing]

Sayın Ömer bey,

Ellerinize ve emeğinize sağlık.
Senaryoyu kurgularken bir konuyu atlamışım, çok özür dileyerek son bir isteğim olacak.
Kücükten_büyüğe doğru sıralarken ">0" sıfırdan büyük olanları getirmesini sağlanmalıdır. Zira, herhangi bir verisi olmayanları listelemiş oluyorum. Burada amaç en küçük değerden itibaren sıralamalıyız.

Saygılarımla.

 

[Believing]

Sayın Ömer bey,

3 nolu mesajdaki senaryoyu nasıl tamamlaya bilirim?

Saygılarımla.

 

[Ömer]

Hem şikayet hem memnuniyet aynı anda sıfır olunca mı dikkate alınmayacak, yoksa biri bile sıfır olsa oda mı dikkate alınmayacak.

 

[Believing]

Sayın Ömer bet,

Evet, memnuniyet ve şikayetler aynı anda sıfır değerine sahipse dikkate alınmayacak.

Saygılarımla.

 

[Ömer]

Deneyiniz.

Sub Listele()

    Dim Sv As Worksheet, son As Long, sutun As Integer, sirala, alan, i As Long, s As Long
    
    Set Sv = Sheets("VERİTABANI")
    son = Sv.Cells(Rows.Count, "A").End(xlUp).Row
    alan = Sv.Range("A3:D" & son).Value
    sutun = ComboBox2.ListIndex + 29
    sirala = xlAscending

    If ComboBox1.Value = "Büyükten_Küçüğe" Then sirala = xlDescending
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With

    Range("AA6:AF" & Rows.Count).Clear
    
    ReDim dizi(1 To son, 1 To 4)
 
    For i = LBound(alan) To UBound(alan)
        If alan(i, 3) <> 0 And alan(i, 4) <> 0 Then
            s = s + 1
            dizi(s, 1) = alan(i, 1)
            dizi(s, 2) = alan(i, 2)
            dizi(s, 3) = alan(i, 3)
            dizi(s, 4) = alan(i, 4)
        End If
    Next i

    Range("AA6").Resize(s, 4) = dizi
    Range("AE6").Resize(s, 1).FormulaLocal = "=EĞERHATA(AD6/AC6;0)"
    Range("AF6").Resize(s, 1).FormulaLocal = "=EĞERHATA(AD6/$AD$4;0)"
    Range("AE:AF").NumberFormat = "0.00%"
    
    Range("AA6:AF" & Rows.Count).Sort Cells(5, sutun), sirala
    Range("AA21:AF" & Rows.Count).Clear
    Range("AA6:AF20").Borders.LineStyle = 1
    
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

Private Sub ComboBox1_Change()
    Listele
End Sub

Private Sub ComboBox2_Change()
    Listele
End Sub

 

[Believing]

Sayın Ömer bey,

Ellerinize emeğinize sağlık. Harika olmuş.
ALLAH sizden razı olsun. Hakkınızı helal ediniz lütfen.
Kolay gelsin.

Saygılarımla.