• DİKKAT

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

Soru Veri süzme ve filtre

  • Konbuyu başlatan Konbuyu başlatan m.gur
  • Başlangıç tarihi Başlangıç tarihi
M

m.gur

Katılım
9 Temmuz 2004
Mesajlar
427
Excel Vers. ve Dili
Office 2007 Tr & Office 2019 Tr
Merhaba, çalışma sayfamda B ve G sütununda bilgiler mevcut. 1inci satırda 2 adet textbox var. Textboxa yazdığım karakterleri yada kelimeyi bulup altalta sıralıyor bunda bir sorun yok ancak ben sayfamın ilk 3 satırını bölüp sabitledim ve filtreledim, sürekli görünmesi gerekiyor. Sıralama yaparken bu bölünen satırlar ve filtre kayboluyor, bunlar nasıl gözükecek. Şimdiden teşekkür ederim.

Kodlar şöyle

Kod: 
Private Sub TextBox1_Change()
On Error Resume Next
Selection.AutoFilter
METİN1 = TextBox1.Value
Set FC1 = Sayfa7.Columns("B").Find(What:=METİN1)
Application.Goto Reference:=Range(FC1.Address), _
Scroll:=False
Sayfa7.Columns("B").AutoFilter field:=1, Criteria1:="*" & TextBox1.Value & "*"
If METİN1 = "" Then
Selection.AutoFilter field:=1
Set FC1 = Nothing: METİN1 = Empty
End If
End Sub

Private Sub TextBox2_Change()
On Error Resume Next
Selection.AutoFilter
METİN2 = TextBox2.Value
Set FC2 = Sayfa7.Columns("G").Find(What:=METİN2)
Application.Goto Reference:=Range(FC2.Address), _
Scroll:=False
Sayfa7.Columns("G").AutoFilter field:=1, Criteria1:="*" & TextBox2.Value & "*"
If METİN2 = "" Then
Selection.AutoFilter field:=1
Set FC2 = Nothing: METİN2 = Empty
Selection.ClearContents
End If
End Sub
 
Ekli dosya

Dosyayı buraya ekledim. Umarım doğru yapmışımdır. Bir inceler misiniz? Teşekkürler.
 
Bir çaresi yok mu acaba ?
 
Sanırım altın üye olmayanlar pek faydalanamıyor bu yardımlardan. Konuyu çözüm bulamadan kapatıyorum. Saygılar.
 
İlgilenen kimse yok sanırım...
 
Örnek dosyanızı (altın üye olmadığınızdan) dosya paylaşım sitelerinden birine yükleyip linkini paylaşır mısınız? Örnek olmadan ne yapmak istediğinizi anlamak zor.
 
Kusura bakmayın, 2 nolu mesaja dikkat etmemişim.

Süzme işlemlerini B sütununun tümünde yapıyorsunuz. Dolayısıyla B1:B3 hücresinde aranan veri olmadığından onlar da gizleniyor.

Aşağıdaki gibi deneyin:

PHP: 
Private Sub TextBox1_Change()
On Error Resume Next
METİN1 = TextBox1.Value
son = Cells(Rows.Count, "B").End(3).Row
Sayfa7.Range("B4:B" & son).AutoFilter
Set FC1 = Sayfa7.Range("B4:B" & son).Find(What:=METİN1)
Application.Goto Reference:=Range(FC1.Address), _
Scroll:=False
Sayfa7.Range("B4:B" & son).AutoFilter field:=1, Criteria1:="*" & TextBox1.Value & "*"
If METİN1 = "" Then
Selection.AutoFilter field:=1
Set FC1 = Nothing: METİN1 = Empty
End If
End Sub

Private Sub TextBox2_Change()
On Error Resume Next
METİN2 = TextBox2.Value
son = Cells(Rows.Count, "G").End(3).Row
Sayfa7.Range("G4:G" & son).AutoFilter
Set FC2 = Sayfa7.Columns("G").Find(What:=METİN2)
Application.Goto Reference:=Range(FC2.Address), _
Scroll:=False
Sayfa7.Range("G4:G" & son).AutoFilter field:=1, Criteria1:="*" & TextBox2.Value & "*"
If METİN2 = "" Then
Selection.AutoFilter field:=1
Set FC2 = Nothing: METİN2 = Empty
Selection.ClearContents
End If
End Sub
 
Sayın YUSUF44 Teşekkür ederim şimdi sabitlediğim satırlar kaybolmuyor ancak benim uygulamış olduğum filtre kayboluyor. Onun bir çaresi var mı?
 
Dosyada 3. satır boş duruyor. O satırı silip aşağıdaki kodları deneyin:

PHP: 
Private Sub TextBox1_Change()
On Error Resume Next
METİN1 = TextBox1.Value
son = Cells(Rows.Count, "B").End(3).Row
Sayfa7.Range("B2:B" & son).AutoFilter
Set FC1 = Sayfa7.Range("B2:B" & son).Find(What:=METİN1)
Application.Goto Reference:=Range(FC1.Address), _
Scroll:=False
Sayfa7.Range("B2:B" & son).AutoFilter field:=1, Criteria1:="*" & TextBox1.Value & "*"
If METİN1 = "" Then
Selection.AutoFilter field:=1
Set FC1 = Nothing: METİN1 = Empty
End If
End Sub

Private Sub TextBox2_Change()
On Error Resume Next
METİN2 = TextBox2.Value
son = Cells(Rows.Count, "G").End(3).Row
Sayfa7.Range("G2:G" & son).AutoFilter
Set FC2 = Sayfa7.Range("G2:G" & son).Find(What:=METİN2)
Application.Goto Reference:=Range(FC2.Address), _
Scroll:=False
Sayfa7.Range("G2:G" & son).AutoFilter field:=1, Criteria1:="*" & TextBox2.Value & "*"
If METİN2 = "" Then
Selection.AutoFilter field:=1
Set FC2 = Nothing: METİN2 = Empty
Selection.ClearContents
End If
End Sub
 
Filtreden kastınız nedir?
 
Eklemiş olduğunuz boş olarak görünen 3. satır filtrenin mantığına ters olduğu için gizleniyor. Gözükmemesi gayet normaldir. O satırı göstermek için koda eklemeler yapmak gerekecektir.

Ek olarak birleştirilmiş hücre kullanmışsınız. Bu da excel için sıkıntılı bir durumdur. Tablo düzeninde kullanılmasını pek tavsiye etmiyoruz.

Dosyanıza göre aşağıdaki kodu deneyebilirsiniz.

Kod: 
Private Sub TextBox1_Change()
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.ShowAllData
    Son = Cells(Rows.Count, 2).End(3).Row
    Say = 1
    Liste = Range("B4:B" & Son).Value
    ReDim Kriter(1 To 1)
    Kriter(Say) = ""
    For X = 1 To UBound(Liste)
        If UCase(Replace(Replace(Liste(X, 1), "ı", "I"), "i", "İ")) Like "*" & _
        UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*" Then
            Say = Say + 1
            ReDim Preserve Kriter(1 To Say)
            Kriter(Say) = CStr(Liste(X, 1))
        End If
    Next
    Range("B2:G" & Son).AutoFilter Field:=1, Criteria1:=Kriter, Operator:=xlFilterValues
    If TextBox1 = Empty Then
        Range("B2:G" & Son).AutoFilter Field:=1
    End If
    Set Bul = Nothing
    Application.ScreenUpdating = True
End Sub

Private Sub TextBox2_Change()
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.ShowAllData
    Son = Cells(Rows.Count, 2).End(3).Row
    Say = 1
    Liste = Range("G4:G" & Son).Value
    ReDim Kriter(1 To 1)
    Kriter(Say) = ""
    For X = 1 To UBound(Liste)
        If UCase(Replace(Replace(Liste(X, 1), "ı", "I"), "i", "İ")) Like "*" & _
        UCase(Replace(Replace(TextBox2, "ı", "I"), "i", "İ")) & "*" Then
            Say = Say + 1
            ReDim Preserve Kriter(1 To Say)
            Kriter(Say) = CStr(Liste(X, 1))
        End If
    Next
    Range("B2:G" & Son).AutoFilter Field:=6, Criteria1:=Kriter, Operator:=xlFilterValues
    If TextBox2 = Empty Then
        Range("B2:G" & Son).AutoFilter Field:=6
    End If
    Set Bul = Nothing
    Application.ScreenUpdating = True
End Sub
 
Sayın Korhan Ayhan çok teşekkür ederim. Sorunsuz çalışıyor şimdi Allah razı olsun..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst