• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Filtredeki seçimi hücreye yazdırma

W

washburn

Katılım
3 Temmuz 2009
Mesajlar
42
Excel Vers. ve Dili
Excel 2007 Türkçe
Merhaba arkadaşlar. çok basit bir sorum var ancak ben bi türlü beceremedim filltrede seçtiğim değeri bir türlü üstteki mavi hücreye yazdıracak kodları çalıştıramadım.. dosyam ektedir...
 

Ekli dosyalar

Selamlar,

Ekte örnek dosyanız üzerinde gerekli düzenlemeyi yaptım. İncelermisiniz.


Kullanılan fonksiyon; (Sn. yurttas'ın bir çalışmasından uyarlanmıştır. Boş bir modüle uygulayınız.)

Kod: 
Function SÜZ_KRİTER(Hücre As Range) As String
    Dim Filter As String
    Filter = ""
    On Error GoTo Son
    With Hücre.Parent.AutoFilter
    If Intersect(Hücre, .Range) Is Nothing Then GoTo Son
    With .Filters(Hücre.Column - .Range.Column + 1)
    If Not .On Then GoTo Son
    Filter = .Criteria1
    Select Case .Operator
    Case xlAnd
    Filter = Filter & " VE " & .Criteria2
    Case xlOr
    Filter = Filter & " VEYA " & .Criteria2
    End Select
    End With
    End With
Son:
    Set WF = WorksheetFunction
    SÜZ_KRİTER = Filter
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, ">", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<>", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, ">=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "*", "")
    Set WF = Nothing
End Function
 

Ekli dosyalar

harika olmuş.. tam istediğim gibi ellerinize sağlık.. ayrıca bu fonksiyonu yaratan Sn.Yurttaş'a da teşekkürlerimi sunuyorum.. Çok saolun Korhan Bey..
 
Korhan Ayhan' Alıntı:
Selamlar,

Ekte örnek dosyanız üzerinde gerekli düzenlemeyi yaptım. İncelermisiniz.


Kullanılan fonksiyon; (Sn. yurttas'ın bir çalışmasından uyarlanmıştır. Boş bir modüle uygulayınız.)

Kod: 
Function SÜZ_KRİTER(Hücre As Range) As String
    Dim Filter As String
    Filter = ""
    On Error GoTo Son
    With Hücre.Parent.AutoFilter
    If Intersect(Hücre, .Range) Is Nothing Then GoTo Son
    With .Filters(Hücre.Column - .Range.Column + 1)
    If Not .On Then GoTo Son
    Filter = .Criteria1
    Select Case .Operator
    Case xlAnd
    Filter = Filter & " VE " & .Criteria2
    Case xlOr
    Filter = Filter & " VEYA " & .Criteria2
    End Select
    End With
    End With
Son:
    Set WF = WorksheetFunction
    SÜZ_KRİTER = Filter
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, ">", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<>", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, ">=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "*", "")
    Set WF = Nothing
End Function
Genişletmek için tıkla ...
Korhan Ayhan' Alıntı:
Selamlar,

Ekte örnek dosyanız üzerinde gerekli düzenlemeyi yaptım. İncelermisiniz.


Kullanılan fonksiyon; (Sn. yurttas'ın bir çalışmasından uyarlanmıştır. Boş bir modüle uygulayınız.)

Kod: 
Function SÜZ_KRİTER(Hücre As Range) As String
    Dim Filter As String
    Filter = ""
    On Error GoTo Son
    With Hücre.Parent.AutoFilter
    If Intersect(Hücre, .Range) Is Nothing Then GoTo Son
    With .Filters(Hücre.Column - .Range.Column + 1)
    If Not .On Then GoTo Son
    Filter = .Criteria1
    Select Case .Operator
    Case xlAnd
    Filter = Filter & " VE " & .Criteria2
    Case xlOr
    Filter = Filter & " VEYA " & .Criteria2
    End Select
    End With
    End With
Son:
    Set WF = WorksheetFunction
    SÜZ_KRİTER = Filter
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, ">", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<>", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "<=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, ">=", "")
    SÜZ_KRİTER = WF.Substitute(SÜZ_KRİTER, "*", "")
    Set WF = Nothing
End Function
Genişletmek için tıkla ...
Korhan Ayhan üstadım KOD paylaşımı için teşekkürler. Bu kodu boş modüle yapıştırdım. Nasıl çalıştırmak lazım ?
Hücreye gelip =SÜZ_KRİTER olarak yazdım #AD hatası verdi !
 
Merhaba,

Fonksiyonun parametrelerini incelerseniz rahatlıkla görebilirsiniz.

A1 filtre uyguladığınız hücre adresidir.

Kod: 
=SÜZ_KRİTER(A1)
 
Korhan Ayhan üstadım, fonksiyon kriteri gayet başarılı yakalıyor. Peki koşulu, yani >, <> gibi bunları da yazdırmak mümkün mü ?
 
üstadım kodu inceleyince bir üstteki sorumun cevabını buldum. ilgine çok teşekkür ediyorum. sağlıcakla kalın
 
Paylaşımlar için teşekkürler.
 
Bu kodu nasıl çalıştırıyoruz acaba
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst