Filtre değerine göre otomatik filtreleme

[MURATSO]

merhaba,
Görev_Kodu_Yetki_Grubu isimli sheetin A kolonunda filtreleme ile bir değer arıyorum ve bunun sonucunda C2 satırında bir değer geliyor. İstediğimi şey ise bu filtreleme sonunda C2 satırına gelen değeri Yetki_Grubu_Uygulama_Rol_Adı sheetin deki C kolonunda da otomatik olarak bulunup güncellenmesi

mümkünse tabi,

teşekkürler

 

[Ömer]

Merhaba,

Sorunuzu örnek dosya ile destekleyip dosya içerisinden detaylı açıklamanızı rica ederim.

.

 

[MURATSO]

Merhaba ekli örnek exceli ekledim.

Bu örneğe göre Görev_Kodu_Yetki_Grubu sheetinden C2 hücresindeki değeri (sadece bu sheett de filtreleme varsa çalışsın) Yetki_Grubu_Uygulama_Rol_Adı sheetinde A kolonunda bulup filtrelesin.

yardımcı olabilirseniz çok sevinirim.

 

[MURATSO]

Farklı bir detay ihtiyacı var ise iletebilirim?

teşekkürler

 

[Ömer]

Bu şekilde deneyin.

Sub Filtre()
    
    Dim Sg As Worksheet, Sy As Worksheet, deg, son As Long

    Set Sg = Sheets("Görev_Kodu_Yetki_Grubu")
    Set Sy = Sheets("Yetki_Grubu_Uygulama_Rol_Adı")
    son = Sy.Cells(Rows.Count, "A").End(xlUp).Row
    
    If Sg.FilterMode = True Then
        deg = Sg.Cells(Sg.Cells(Rows.Count, "A").End(xlUp).Row, "C")
        Sy.Range("A1:C" & son).AutoFilter Field:=1, Criteria1:=deg
    Else
        Sy.Range("A1:C" & son).AutoFilter Field:=1
    End If

End Sub

.

 

[MURATSO]

Ömer bey elinize sağlık tam istediğim gibi olmuş. Denemeler yaparken aslında başka bir ihtiyaç daha çıktı. Görev_Kodu_Yetki_Grubu sheetindeki C kolonunda birden fazla yetki grubu var ise en son satırda olanı baz alarak sadece onu filtreliyor. C kolonunda kaç farklı yetki grubu sıralandı ise Yetki_Grubu_Uygulama_Rol_Adı sheetinde hepsini alfabetik sırayla listeleyebilir miyiz?

şimdiden desteğiniz ve ilginiz için teşekkür ederim.

 

[Ömer]

Bu şekilde deneyin.

Sub Filtre()
    
    Dim Sg As Worksheet, Sy As Worksheet, deg, a As Long
    Dim son1 As Long, son2 As Long, c As Range, dizi()

    Set Sg = Sheets("Görev_Kodu_Yetki_Grubu")
    Set Sy = Sheets("Yetki_Grubu_Uygulama_Rol_Adı")
    son1 = Sy.Cells(Rows.Count, "A").End(xlUp).Row
    son2 = Sg.Cells(Rows.Count, "A").End(xlUp).Row
    
    If Sg.FilterMode = True Then
        For Each c In Sg.Range("C2:C" & son2).SpecialCells(xlCellTypeVisible)
            If c <> "" Then
                ReDim Preserve dizi(a)
                dizi(a) = c
                a = a + 1
            End If
         Next c
        Sy.Range("A1:C" & son1).AutoFilter Field:=1, _
            Criteria1:=dizi, Operator:=xlFilterValues
    Else
        Sy.Range("A1:C" & son1).AutoFilter Field:=1
    End If

End Sub

.

 

[MURATSO]

Ömer Bey; elinize, emeğinize sağlık. Gerçekten süper olmuş.
çok teşekkür ederim yardım ve desteğiniz için.

syg.

 

[MURATSO]

Ömer bey merhaba,

sizin için sorun olmaz ise küçük bir ekleme daha yapabilir miyiz?

Görev_Kodu_Yetki_Grubu_2 diye bir sheet daha olsun istiyorum burada da Yetki_Grubu_Uygulama_Rol_Adı shetindeki A kolonunda bulunan yetki gruplarını Görev_Kodu_Yetki_Grubu_2 sheetindeki C kolonunda otomatik seçerek filtrelesin.

mümkün müdür?

teşekkür ederim.

syg.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Filtre_Yeni()
    
    Dim Sg As Worksheet, Sy As Worksheet, deg, a As Long, dizi()
    Dim son1 As Long, son2 As Long, c As Range, d As Object
    
    Set d = CreateObject("Scripting.Dictionary")
    Set Sg = Sheets("Görev_Kodu_Yetki_Grubu_2")
    Set Sy = Sheets("Yetki_Grubu_Uygulama_Rol_Adı")
    son1 = Sg.Cells(Rows.Count, "A").End(xlUp).Row
    son2 = Sy.Cells(Rows.Count, "A").End(xlUp).Row
    
    If Sy.FilterMode = True Then
        For Each c In Sy.Range("A2:A" & son2).SpecialCells(xlCellTypeVisible)
            If c <> "" Then
                If Not d.exists(c) Then
                    d.Add c, Nothing
                End If
            End If
        Next c
        Sg.Range("A1:C" & son1).AutoFilter Field:=3, _
            Criteria1:=d.keys, Operator:=xlFilterValues
    Else
        Sg.Range("A1:C" & son1).AutoFilter Field:=3
    End If

End Sub

.

 

[MURATSO]

Ömer bey hakkınızı helal edin elinize sağlık

çoook teşekkür ederim.

 

[MURATSO]

Ömer bey merhaba, bir önceki kodda çalıştır dendiğinde hem önceki hem de son istediğim sonucu aynı anda yapma şansımız var mı?

syg.

 

[Ömer]

İki koduda module kopyaladınız sanırım.

Daha sonra aşağıdaki koduda module kopyalayın.

Artık sadece aşağıdaki verdiğim kodu çalıştırırsanız 2 kod arka arkaya çalışır.

Sub Calistir()
    Call Filtre
    Call Filtre_Yeni
End Sub

.

 

[MURATSO]

çok teşekkür ederim

 

[MURATSO]

son bir isteğim olabilir mi Ömer bey? sizi yormamak adına Kendim denedim ama beceremedim

Çalışan Listesi_20042017 adında bir sheet daha ekledim. Görev_Kodu_Yetki_Grubu_2 sheetinn A kolonunda sıralanan Görev kodlarını Çalışan Listesi_20042017 sheetinin A kolonunda bularak filtrelesin istiyorum. denedim kendim ama yapamadım

 

[MURATSO]

Ömer bey merhaba, Örnek dosyayı da ekledim. Daha önce verdiğiniz kodlar da içinde. teşekkür ederim.

syg.

 

[MURATSO]

en azından nasıl yapmam gerektiğini de söyleyebilirseniz kendim deneyeyim ama yoğunsanız yine de canınız sağ olsun zaten çok yardımcı oldunuz önceki kodlarda

 

[Ömer]

Öncelikle, Çalışan Listesi_20042017 sayfasında A yada B sütunlarındaki herhangi bir hücreyi seçin ve Tasarım menüsünden "Tabloyu Normal Aralığa Dönüştür" seçeneğini işaretleyin.

Daha sonra eski ve aşağıda verdiğim tüm kodlar dahil, kodları çalışma sayfasının kod bölümüne değil, VBA ekranında Insert menüsünden Module ekleyip bu sayfaya yapıştırın.

Sub Filtre_Yeni_2()
    
    Dim Sg As Worksheet, Sy As Worksheet, deg, a As Long, dizi()
    Dim son1 As Long, son2 As Long, c As Range, d As Object
    
    Set d = CreateObject("Scripting.Dictionary")
    Set Sg = Sheets("Çalışan Listesi_20042017")
    Set Sy = Sheets("Görev_Kodu_Yetki_Grubu_2")
    
    Sg.Range("A1:F" & Rows.Count).AutoFilter Field:=1
    son1 = Sg.Cells(Rows.Count, "A").End(xlUp).Row
    son2 = Sy.Cells(Rows.Count, "A").End(xlUp).Row
    
    If Sy.FilterMode = True Then
        For Each c In Sy.Range("A2:A" & son2).SpecialCells(xlCellTypeVisible)
            If c <> "" Then
                If Not d.exists(c) Then
                    d.Add c & "", Nothing
                End If
            End If
        Next c
        Sg.Range("A1:F" & son1).AutoFilter Field:=1, _
            Criteria1:=d.keys, Operator:=xlFilterValues
    Else
        Sg.Range("A1:F" & son1).AutoFilter Field:=1
    End If

End Sub

.

 

[MURATSO]

Ömer bey elinize sağlık tam istediğim gibi olmuş. Çok teşekkür ederim.