Şartlı Gizle Göster, Git

[Çetin Çelik]

Arkadaşlar öncelikle durum acil ve şimdiden herkese teşekkür ediyorum.

Q2 hücresindeki yazıyı veya en yakın sonucu A3 ile A sütunun dolu olan son satırları içinde arayacak. buldukları haricindeki diğer tüm satırları gizleyecek.

A sütunu isim listesi olduğu için aynı isimden 2 veya daha fazla olma ihtimali var o nedenle benzer sonuçların olduğu satırlar haricindekileri gizlesin istiyorum.

Q2 deki veriyi silince gizlenenler tekrar gösterilecek.

bu sorunum için lütfen bir makro.

Lifebox Transfer: Upload File! Send and Share Large Files

Lifeboxtransfer is a fast file transfer service for sharing your files easily without membership. Click and start sharing your files fast and easily with lifeboxtransfer.

lifeboxtransfer.com

 

[yusuf1284]

Örnek dosya ekler misiniz anlayamadım istediğinizi

 

[Çetin Çelik]

Örnek dosya ekler misiniz anlayamadım istediğinizi

Yusuf hocam örnek dosyayı nasıl yüklerim bilmiyorum ama istediğim şeyin sizin için basit olduğunu biliyorum.

Q2 hücresinde "Ahmet" yazıyor varsayalım.
A3 ile A253 arasında 250 adet isim yazılı ve karışık.
A sütununda "Ahmet" kelimesini içeren satırlar kalacak ve gerisi gizlenecek.

Q2 yi temizlediğimde ise gizli olanlar tekrar görünecek.

hepsi bu.

Eğer mümkünse bunu şöyle yapmak isterim.
Q2 ye aramak istediğim kelimeyi girip Q2 den başka bir hücreye çıkınca (enter basınca veya tab tuşuna basınca yani Q2 ayrıldığımda) makro çalışsın. olmazsa buton ile de yapabilirim sorun değil.

Eğer doğru yaptıysam dosya paylaşım ile çözdüm Yusuf Hocam

Lifebox Transfer: Upload File! Send and Share Large Files

Lifeboxtransfer is a fast file transfer service for sharing your files easily without membership. Click and start sharing your files fast and easily with lifeboxtransfer.

lifeboxtransfer.com

 

[veyselemre]

Autofilter ile yapmak isterseniz.
A1:A3 hücresini birleştirmeyin. A3:A aralığında filtre yapar.

Kodu sayfanın kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("Q2")) Is Nothing Then
        With Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
            If .Parent.AutoFilterMode Then .AutoFilter
            If Target.Value <> "" Then .AutoFilter 1, "*" & Target.Value & "*"
        End With
    End If
End Sub

 

[Çetin Çelik]

Teşekkür ederim arkadaşlar. Henüz denemedim ama önemli olan emeğiniz olduğu için teşekkürler. Elinize sağlık.

 

[Çetin Çelik]

Autofilter ile yapmak isterseniz.
A1:A3 hücresini birleştirmeyin. A3:A aralığında filtre yapar.
Ekli dosyayı görüntüle 249531
Kodu sayfanın kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("Q2")) Is Nothing Then
        With Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
            If .Parent.AutoFilterMode Then .AutoFilter
            If Target.Value <> "" Then .AutoFilter 1, "*" & Target.Value & "*"
        End With
    End If
End Sub

Mükemmel çalıştı, teşekkürler

 

[Çetin Çelik]

Deneyiniz

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("Q2")) Is Nothing Then
        FilterNames
    End If
End Sub

Sub FilterNames()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
  
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.ActiveSheet
  
    Dim filterName As String
    filterName = ws.Range("Q2").Value
    Dim cell As Range 
    ws.Rows.Hidden = False

    If filterName = "" Then
        GoTo Cleanup
    End If

    For Each cell In ws.Range("A3:A253")
        If Not cell.Value Like "*" & filterName & "*" Then
            cell.EntireRow.Hidden = True
        End If
    Next cell
  
End Sub

Hocam

If filterName = "" Then
GoTo Cleanup
End If

sizin kodu denediğimde bu kısımda hata verdi. GoTo cleanup kısmını silip MsgBox "Arama Kutusuna Veri Girmelisiniz." yazdım ama Q2 verisini silip enter yaptığımda bu defa hiç hata vermedi ama mesaj da görünmedi. doğal olarak gizli satırları tekrar görünür hale getiremediğim için tekrar filtreleme yapamadım.

Emeğiniz için teşekkürler.

Fakat hatayı düzeltebilirsem arşive ekleyeceğim. Aynı soruları tekrar tekrar sormamak için kodları arşivliyorum.