Filtre değerine göre otomatik filtreleme

**MURATSO** · 12-04-2017, 15:18

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** · 12-04-2017, 17:19

Merhaba,

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

.

**MURATSO** · 13-04-2017, 08:08

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** · 13-04-2017, 09:33

Farklı bir detay ihtiyacı var ise iletebilirim?

teşekkürler

**Ömer** · 13-04-2017, 09:55

Bu şekilde deneyin.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)

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** · 13-04-2017, 10:09

Ö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** · 13-04-2017, 11:21

Bu şekilde deneyin.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)

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** · 13-04-2017, 13:21

Ö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** · 19-04-2017, 16:43

Ö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** · 19-04-2017, 22:24

Merhaba,

Bu şekilde deneyin.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)

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

.

12-04-2017, 15:18	#1
MURATSO Altın Üye Giriş: 03/04/2014 Şehir: istanbul Mesaj: 156 Excel Vers. ve Dili: excel 2010	Filtre değerine göre otomatik filtreleme 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

12-04-2017, 17:19	#2
Ömer Moderatör Giriş: 18/08/2007 Şehir: Kuşadası Mesaj: 18,710 Excel Vers. ve Dili: Excel 2010 Türkçe	Merhaba, Sorunuzu örnek dosya ile destekleyip dosya içerisinden detaylı açıklamanızı rica ederim. . __________________ . FORUM KURALLARI

Konu Araçları
Yazıcı Çıktısını Göster Sayfayı E-posta ile Yolla
Görünüm Modları
Düzenli Mod Karışık Moda Geç Konu Moduna Geç

13-04-2017, 09:33	#4
MURATSO Altın Üye Giriş: 03/04/2014 Şehir: istanbul Mesaj: 156 Excel Vers. ve Dili: excel 2010	Farklı bir detay ihtiyacı var ise iletebilirim? teşekkürler

13-04-2017, 10:09	#6
MURATSO Altın Üye Giriş: 03/04/2014 Şehir: istanbul Mesaj: 156 Excel Vers. ve Dili: excel 2010	Ö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.

13-04-2017, 13:21	#8
MURATSO Altın Üye Giriş: 03/04/2014 Şehir: istanbul Mesaj: 156 Excel Vers. ve Dili: excel 2010	Ö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.