Filtreleme makrosuna değişken kriter girme hk.

[methura]

Öncelikler herkese iyi günler,

Karmaşık bir liste içerisinde filtreleme yapmak için makroları kullanmaktayım. Bu dosyayı 3. kişilerde kullanmakta.
Halihazırda öngördüğüm tüm filtreleme kriterlerini makro haline getirdim, bu makroları tuşlar vs halinde kullanıcılara sunmaktayım.

Sorum şu: Değişken (sonradan yazılan, listeden seçilen vs.) bir hücredeki bilgiyi filtre kriterlerine girebilmenin yolu var mıdır?

örneğin aşağıdaki kod "İzmir, Ankara ve İstanbul" ile ilgili filtrelemeyi yapan bir makroya ait

**** ActiveSheet.Range("$A$1:$S$1526").AutoFilter Field:=5, Criteria1:=Array( _
"Ankara", "izmir", "istanbul"), Operator:= _
xlFilterValues ****

İstediğim şey kullanıcı bir hücreye (veya listeden seçerek) "Diyarbakır" yazdığında yukarıdaki makronun Criteria1 kısmına sadece "Diyarbakır" girmesi.

Kısaca "önceden hazırlanmış bir makro kalıbına sonradan bilgi eklenerek, makronun criteriası değiştirilebilir mi?"

Umarım anlatabilmişimdir, herkese okuduğu ve zaman ayırdığı için şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Sayfa2 A sütununa yazdığınız ölçüt(lere) göre işlem yapar.

Sub Filtre()

    Dim S2 As Worksheet, dizi(), a As Byte, i As Byte

    Set S2 = Sheets("Sayfa2")

    For i = 1 To S2.Cells(Rows.Count, "A").End(xlUp).Row
        If S2.Cells(i, "A") <> "" Then
            ReDim Preserve dizi(a)
            dizi(a) = S2.Cells(i, "A")
            a = a + 1
        End If
    Next i

    ActiveSheet.Range("$A$1:$S$1526").AutoFilter Field:=5, Criteria1:=dizi, _
        Operator:=xlFilterValues

End Sub

 

[methura]

Merhaba,

Sayfa2 A sütununa yazdığınız ölçüt(lere) göre işlem yapar.

Sub Filtre()

    Dim S2 As Worksheet, dizi(), a As Byte, i As Byte

    Set S2 = Sheets("Sayfa2")

    For i = 1 To S2.Cells(Rows.Count, "A").End(xlUp).Row
        If S2.Cells(i, "A") <> "" Then
            ReDim Preserve dizi(a)
            dizi(a) = S2.Cells(i, "A")
            a = a + 1
        End If
    Next i

    ActiveSheet.Range("$A$1:$S$1526").AutoFilter Field:=5, Criteria1:=dizi, _
        Operator:=xlFilterValues

End Sub

Çok teşekkürler Ömer Bey, layıkıyla işimi gördü fakat Sayfa2 A sütunundaki tüm bilgileri ekliyor,
spesifik olarak A2'den almasını istediğim zaman neresini değiştirmeliyim kodu?

 

[Ömer]

Tam olarak anlamadım. Sadece A2 deki veriyi mi alsın istiyorsunuz, birden fazla ölçüt olursa nasıl işlem görecek. Sorunuzu daha detaylı açıklar mısınız.

 

[methura]

Yukarıdaki kodda A sütununa yazılan tüm verileri ekliyor. (Örn: A1'den A12'ye kadar dolu hücrelerden 12 adet veri çekiyor)

Sorum sadece tek 1 hücreden çekmesi. Yani spesifik adres belirtmek istediğimde nereyi değiştirmeliyim. (örneğin : A2 veya H12 veya J2 'den 1 hücreden veri çekmesi).

Muhtemelen çok basit bir değişim fakat bilmediğimden sormaktayım. Bilgisizliğimi mazur görün lütfen

 

[Ömer]

Tek hücreye birden fazla ölçüt yazma durumunuz var mı?

 

[methura]

İl ve ilçeler için kullanmaktayız sistemi ama Tek hücrede yazılı her şey.
Ölçüt 1 kelimeden oluşabildiği gibi birkaç kelimeden de oluşabiliyor fakat dediğim gibi hepsi tek hücrede.

Örneğin : "Marmara Ereğli" , "İzmir Urla" , "Diyarbakır Bismil"

gibi.

 

[Ömer]

Bu şekilde deneyin. Yalnız verileri girerken tırnak işareti kullanmayın ve veriler arasına örnekteki gibi virgül kullanın.

Marmara Ereğli , İzmir Urla , Diyarbakır Bismil

Sub Filtre1()

    Dim S2 As Worksheet, dizi(), a As Byte, i As Byte, deg

    Set S2 = Sheets("Sayfa2")
  
    deg = Split(S2.[A2], ",")
    For i = 0 To UBound(deg)
        ReDim Preserve dizi(i)
        dizi(i) = deg(i)
    Next i

    ActiveSheet.Range("$A$1:$S$1526").AutoFilter Field:=5, Criteria1:=dizi, _
        Operator:=xlFilterValues

End Sub

 

[methura]

Emeğinize sağlık Ömer Bey

 

[methura]

Bu şekilde deneyin. Yalnız verileri girerken tırnak işareti kullanmayın ve veriler arasına örnekteki gibi virgül kullanın.

Marmara Ereğli , İzmir Urla , Diyarbakır Bismil

Sub Filtre1()

    Dim S2 As Worksheet, dizi(), a As Byte, i As Byte, deg

    Set S2 = Sheets("Sayfa2")
 
    deg = Split(S2.[A2], ",")
    For i = 0 To UBound(deg)
        ReDim Preserve dizi(i)
        dizi(i) = deg(i)
    Next i

    ActiveSheet.Range("$A$1:$S$1526").AutoFilter Field:=5, Criteria1:=dizi, _
        Operator:=xlFilterValues

End Sub

Ömer bey,

Kodu güzel bir şekilde kullanıyorum fakat tarih filtrelemesinde çalışmıyor, debug moduna giriyor.

Sanırım küçüktür ve büyüktür işaretleri bozuyor. ">01.01.2019" gibi.

Kodu tarih için revize edebilir miyiz?

teşekkürler