Hücre Seçerek Filtreleme

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
Merhaba

Ekte, Sayın Korhan Ayhan uzmanımızın kodlarıyla oluşturmuş olduğum örnek dosya vardır.

1. satırdaki kelimelere göre hatasızca filtreleme yapmaktadır. 2. , 3. veya oluşturduğum diğer satırlardaki kelimelere göre de filtreleme yapmasını istemekteyim.

(örnek vermem gerekirse, sadece C1 i tıkladığımda C1 e göre filtreleme yapması gerekir. Hem C1 e hem de K4 e tıkladığımda ikisine göre filtreleme yapması gerekir.)

(Birden fazla tıklama olayını, Ctrl düğmesine basarak yapılacak şekilde düşünebiliriz)


Ayrıca bu soru çözülünce bu konuyla ilgili bir-iki sorum daha olacak.

Teşekkürler


Amacım hücrelere tıklayarak yani hücreleri seçerek, istediğim şekilde filtrelemeyi hızlıca yapabilmektir.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Veri As Range, Say1 As Long, Say2 As Long, Say3 As Long, Say4 As Long
   
    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    Application.ScreenUpdating = True
   
    If Intersect(Target, Range("B1:AZ4")) Is Nothing Then Exit Sub
   
    Application.ScreenUpdating = False
   
    ReDim Liste1(1 To 1)
    ReDim Liste2(1 To 1)
    ReDim Liste3(1 To 1)
    ReDim Liste4(1 To 1)
   
    For Each Veri In Selection
        Select Case Veri.Row
            Case 1
            If Veri.Value <> "" Then
                Say1 = Say1 + 1
                ReDim Preserve Liste1(1 To Say1)
                Liste1(Say1) = CStr(Veri.Value)
            End If
            Case 2
            If Veri.Value <> "" Then
                Say2 = Say2 + 1
                ReDim Preserve Liste2(1 To Say2)
                Liste2(Say2) = CStr(Veri.Value)
            End If
            Case 3
            If Veri.Value <> "" Then
                Say3 = Say3 + 1
                ReDim Preserve Liste3(1 To Say3)
                Liste3(Say3) = CStr(Veri.Value)
            End If
            Case 4
            If Veri.Value <> "" Then
                Say4 = Say4 + 1
                ReDim Preserve Liste4(1 To Say4)
                Liste4(Say4) = CStr(Veri.Value)
            End If
        End Select
    Next

    With Range("A8:G" & Rows.Count)
        If Say1 > 0 Then .AutoFilter 3, Criteria1:=Liste1, Operator:=xlFilterValues
        If Say2 > 0 Then .AutoFilter 4, Criteria1:=Liste2, Operator:=xlFilterValues
        If Say3 > 0 Then .AutoFilter 6, Criteria1:=Liste3, Operator:=xlFilterValues
        If Say4 > 0 Then .AutoFilter 7, Criteria1:=Liste4, Operator:=xlFilterValues
    End With
   
    Application.ScreenUpdating = True
End Sub
 
Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
Uzmanım kelimenin tam anlamıyla ömürlük ve kusursuz kod yazmışsınız. Ömrüm yettiğince muhafaza edeceğim.

İlave olarak şunu soracaktım, diyecektim ki:
“Aynı satırda birden fazla hücreyi seçebiliyor muyuz” diyecektim. Denedim, seçilebiliyor. İkinci soruya gerek bile kalmadı.
Emeğinize fikrinize sağlık uzmanım.
:)
 
Son düzenleme:

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
En son satırdaki "Son" yazan bölümü revize ettim. Önceki koddan kalmıştı. Atlamışım.
 
Üst