• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kod Birleştirme Hakkında

  • Konbuyu başlatan Konbuyu başlatan petsiye
  • Başlangıç tarihi Başlangıç tarihi

petsiye

Altın Üye
Katılım
28 Eylül 2009
Mesajlar
193
Excel Vers. ve Dili
Office 2019 TR 32 Bit
Merhaba,

Aşağıdaki gibi bir yardıma ihtiyacım var,






1.Gurup Filtre

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=3507, Criteria1:="=*VAR*" _
, Operator:=xlAnd

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=6504, Criteria1:="=*VAR*" _
, Operator:=xlAnd

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=4258, Criteria1:="=*VAR*" _
, Operator:=xlAnd







2.Gurup Filtre

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=4502, Criteria1:="=*VAR*" _
, Operator:=xlAnd

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=6523, Criteria1:="=*VAR*" _
, Operator:=xlAnd

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=5998, Criteria1:="=*VAR*" _
, Operator:=xlAnd






3.Gurup Filtre

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=5778, Criteria1:="=*VAR*" _
, Operator:=xlAnd

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=5002, Criteria1:="=*VAR*" _
, Operator:=xlAnd

ActiveSheet.Range("$A$2:$JVK$5001").AutoFilter Field:=6154, Criteria1:="=*VAR*" _
, Operator:=xlAnd





Yukarıdaki kodlar yardımıyla otomatik filtreleme yapıyorum. Olmasını istediğim konu şu; Eğer 1. Grup filtreleme sonucunda C3:C2500 Aralığında Hiçbir İfade bulunmuyorsa yani ilgili aralıktaki hücreler BOŞSA , 2 Grup Filtreyi uygulasın. Eğer 2. Grup Filtreyi uyguladığında da yine C3:C2500 aralığında hiçbir ifade yoksa yani ilgili aralıktaki hücreler BOŞSA 3. Grup filtreyi uygulasın.


Yardımcı olabiliecek kişilere şimdiden çok Teşekkür Ederim.


Saygılarımla
 
Kod:
Sub ApplyFilters()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim rng As Range
    Set rng = ws.Range("C3:C2500")

    ' 1. Grup Filtre
    ws.Range("$A$2:$JVK$5001").AutoFilter Field:=3507, Criteria1:="=*VAR*", Operator:=xlAnd
    ws.Range("$A$2:$JVK$5001").AutoFilter Field:=6504, Criteria1:="=*VAR*", Operator:=xlAnd
    ws.Range("$A$2:$JVK$5001").AutoFilter Field:=4258, Criteria1:="=*VAR*", Operator:=xlAnd

    If Application.WorksheetFunction.CountA(rng) = 0 Then
        ' 2. Grup Filtre
        ws.Range("$A$2:$JVK$5001").AutoFilter Field:=4502, Criteria1:="=*VAR*", Operator:=xlAnd
        ws.Range("$A$2:$JVK$5001").AutoFilter Field:=6523, Criteria1:="=*VAR*", Operator:=xlAnd
        ws.Range("$A$2:$JVK$5001").AutoFilter Field:=5998, Criteria1:="=*VAR*", Operator:=xlAnd

        If Application.WorksheetFunction.CountA(rng) = 0 Then
            ' 3. Grup Filtre
            ws.Range("$A$2:$JVK$5001").AutoFilter Field:=5778, Criteria1:="=*VAR*", Operator:=xlAnd
            ws.Range("$A$2:$JVK$5001").AutoFilter Field:=5002, Criteria1:="=*VAR*", Operator:=xlAnd
            ws.Range("$A$2:$JVK$5001").AutoFilter Field:=6154, Criteria1:="=*VAR*", Operator:=xlAnd
        End If
    End If

End Sub
 
Yukarıdaki soruma ilane olarak,

Verdiğiniz kodlarda, eğer 1. Grup sonucunda C3:C2500 arasındaki hücrelerin arasında eğer en az 1 tane dolu hücre var ise, " 1 Grup Sinyali Verildi" şeklinde küçük bir Pop-Up penceresi uyarısın verilmesini nasıl sağlarım acaba ?
 
Gerçekten çok Teşekkür ederim Sayın @pitchoute
 
Geri
Üst