Filtre sonucunu hücreye aktarma

[fikretac]

Merhaba arkadaşlar. Korumalı sayfada 70 sütündan olusan bir tabloda islem yaparken, sutunlarda filtreleme kullanıyorum. Filtreleme devamlı var. Herhangi bir sütunda filtreleme yapılıp yapılmadıgını takip etmek zor oluyor. Benim sorum;
1. Filtreleme sonucunu hücrede veya sekil iceresinde görme imkanımız var mı?
2. Bu sütunlardan herhangi birinde filtreleme yapılmıs olduğunu bir hücrede veya sekil icresinde ikaz vermesini saglayabilirmiyiz?

 

[HücrelereFısıldayanAdam]

1.soruyu anlayamadım. 2. için ise:
a)Çok fazla sutunlu sayfalar için sürekli her işlemden önce alışkanlık olarak, filtreleri kapatıp açıyorum, Ctrl +Shift +L
b) Daha iyisi, herhangi bir sütun filtreli ise sol köşede otomatik bir görsel uyarı göstermesi bir private sub ile sağlanabilir.

 

[dEdE]

Merhaba,
Aşağıdaki kodlar filtreli sütunları bulur ve MsgBox içinde gösterir.

Sub Filtreli()
   With ActiveSheet.AutoFilter
      For i = 1 To .Filters.Count
         If .Filters(i).On Then
            x = x & Split(Columns(i).Address, ":$")(1) & ", "
         End If
      Next i
   End With
If Len(x) = 0 Then
    MsgBox "Filtrelenmiş sütun yok."
Else
   MsgBox "Filtreli Sütunlar " & Left(x, Len(x) - 2)
End If
End Sub

 

[fikretac]

Sayın dEdE makronuzu ekledim evet filtreli sütun var diyor fakat sütun harflerini 3 sütun eksik veriyor... düzeltme imkanımız var mı? veya filtreli sutunların 5 nci hücrelerini renklendirebilirmiyiz...

 

[fikretac]

Sayın dEdE makronuzda sorun yok. A sütunu dahil filtresiz sütun olmaması gerekiyormus, bunu düzeltim. Sütunu veya sütundaki tek hucreyi renklendirebikirsek daha kullanıslı olacak...

 

[HücrelereFısıldayanAdam]

dEdE'nin makrosuna, renkli uyarı ekleyelim:
Neden A1'i renklendiriyoruz, çünkü ekrana sığmayan sütunları göremeyiz.

Sub FILTRE_VARSA_SUTUNU_BILDIR_VE_A1_RENKLENDIR()
    Dim i As Integer
    Dim x As String
    Dim filtreVar As Boolean
    filtreVar = False

    With ActiveSheet.AutoFilter
        For i = 1 To .Filters.Count
            If .Filters(i).On Then
                x = x & Split(Columns(i).Address, ":$")(1) & ", "
                filtreVar = True
            End If
        Next i
    End With
    If Len(x) = 0 Then
        MsgBox "Filtrelenmiş sütun YOK."
    Else
       MsgBox "Filtreli Sütunlar " & Left(x, Len(x) - 2)
    End If
    'Filtre varsa A1 Arkaplanı açık mor olsun, yoksa rengi temizle
    If filtreVar Then
        Range("A1").Interior.Color = RGB(155, 143, 204)
    Else
        Range("A1").Interior.ColorIndex = 0
    End If
End Sub

 

[NADİR YILDIZ]

Arkadaşlar merhaba
bu makro koduna filtreli sütunların başlıklarını renklendirebilirmiyiz.
teşekkürler

 

[fikretac]

fdemirci7 elinize saglik tsk ederim

 

[veyselemre]

Arkadaşlar merhaba
bu makro koduna filtreli sütunların başlıklarını renklendirebilirmiyiz.
teşekkürler

Private Sub CommandButton1_Click()
    Dim i As Integer
    With ActiveSheet.AutoFilter
        .Range.Rows(1).Interior.ColorIndex = 0
        For i = 1 To .Filters.Count
            If .Filters(i).On Then .Range.Cells(i).Interior.Color = RGB(155, 143, 204)
        Next i
    End With
End Sub

 

[NADİR YILDIZ]

Veysel bey teşekkür ederim

iyi çalışmalar

 

[fikretac]

Private Sub CommandButton1_Click()
    Dim i As Integer
    With ActiveSheet.AutoFilter
        .Range.Rows(1).Interior.ColorIndex = 0
        For i = 1 To .Filters.Count
            If .Filters(i).On Then .Range.Cells(i).Interior.Color = RGB(155, 143, 204)
        Next i
    End With
End Sub

Veysel bey elinize saglık tsk ederim. Bu makroya asagıdaki islemide ekleyebilirmiyiz...
If filtreVar Then
Range("A1").Interior.Color = RGB(155, 143, 204)
Else
Range("A1").Interior.ColorIndex = 0
End If

 

[veyselemre]

Veysel bey elinize saglık tsk ederim. Bu makroya asagıdaki islemide ekleyebilirmiyiz...
If filtreVar Then
Range("A1").Interior.Color = RGB(155, 143, 204)
Else
Range("A1").Interior.ColorIndex = 0
End If

Private Sub CommandButton1_Click()
    Dim i As Integer
    With ActiveSheet.AutoFilter
         Union(.Range.Rows(1), Range("A1")).Interior.ColorIndex = 0
        For i = 1 To .Filters.Count
            If .Filters(i).On Then
                Union(.Range.Cells(i), Range("A1")).Interior.Color = RGB(155, 143, 204)
            End If
        Next i
    End With
End Sub