Filtredeki seçimi hücreye yazdırma

[washburn]

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...

 

[Korhan Ayhan]

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.)

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

 

[washburn]

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..

 

[Merhum İdris SERDAR]

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...

.

Dosyanız ekte.

.

 

[baydeniro]

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.)

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

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.)

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

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 !

 

[Korhan Ayhan]

Merhaba,

Fonksiyonun parametrelerini incelerseniz rahatlıkla görebilirsiniz.

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

=SÜZ_KRİTER(A1)

 

[baydeniro]

Üstadım harikasınız. çok teşekkür ediyorum

 

[baydeniro]

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ü ?

 

[baydeniro]

üstadım kodu inceleyince bir üstteki sorumun cevabını buldum. ilgine çok teşekkür ediyorum. sağlıcakla kalın

 

[PriveT]

Paylaşımlar için teşekkürler.

 

[selcukbezmez]

Bu kodu nasıl çalıştırıyoruz acaba