Kod Birleştirme Hakkında

[petsiye]

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

 

[muhasebeciyiz]

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

 

[petsiye]

Yanıtınız için Çok Teşekkür Ederim Sayın @muhasebeciyiz

 

[petsiye]

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 ?

 

[pitchoute]

Merhaba, şu şekilde düzenlemeniz istediğiniz sonucu verecektir düşüncesindeyim;

Sub ApplyFilters()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim rng As Range
    Set rng = ws.Range("C3:C2500")
    
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If

    Dim dataRange As Range
    Set dataRange = ws.Range("$A$2:$JVK$5001")

    ' 1. Grup Filtre
    dataRange.AutoFilter Field:=3507, Criteria1:="=*VAR*", Operator:=xlAnd
    dataRange.AutoFilter Field:=6504, Criteria1:="=*VAR*", Operator:=xlAnd
    dataRange.AutoFilter Field:=4258, Criteria1:="=*VAR*", Operator:=xlAnd
    If Application.WorksheetFunction.Subtotal(103, rng) > 0 Then
        MsgBox "1 Grup Sinyali Verildi", vbInformation
    Else
        If ws.FilterMode Then ws.ShowAllData

        ' 2. Grup Filtre
        dataRange.AutoFilter Field:=4502, Criteria1:="=*VAR*", Operator:=xlAnd
        dataRange.AutoFilter Field:=6523, Criteria1:="=*VAR*", Operator:=xlAnd
        dataRange.AutoFilter Field:=5998, Criteria1:="=*VAR*", Operator:=xlAnd
        If Application.WorksheetFunction.Subtotal(103, rng) > 0 Then
            MsgBox "2 Grup Sinyali Verildi", vbInformation
        Else
            If ws.FilterMode Then ws.ShowAllData

            ' 3. Grup Filtre
            dataRange.AutoFilter Field:=5778, Criteria1:="=*VAR*", Operator:=xlAnd
            dataRange.AutoFilter Field:=5002, Criteria1:="=*VAR*", Operator:=xlAnd
            dataRange.AutoFilter Field:=6154, Criteria1:="=*VAR*", Operator:=xlAnd
            If Application.WorksheetFunction.Subtotal(103, rng) > 0 Then
                MsgBox "3 Grup Sinyali Verildi", vbInformation
            Else
                MsgBox "Hiçbir sinyal bulunamadı.", vbExclamation
            End If
        End If
    End If
End Sub

 

[petsiye]

Gerçekten çok Teşekkür ederim Sayın @pitchoute

 

[pitchoute]

Rica ederim hocam iyi çalışmalar