Soru Veri süzme ve filtre

Katılım
9 Temmuz 2004
Mesajlar
384
Beğeniler
0
Excel Vers. ve Dili
Office 2003 Tr & Office 2010 Tr
#1
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
 
Katılım
9 Temmuz 2004
Mesajlar
384
Beğeniler
0
Excel Vers. ve Dili
Office 2003 Tr & Office 2010 Tr
#2
Ekli dosya

Dosyayı buraya ekledim. Umarım doğru yapmışımdır. Bir inceler misiniz? Teşekkürler.
 
Katılım
9 Temmuz 2004
Mesajlar
384
Beğeniler
0
Excel Vers. ve Dili
Office 2003 Tr & Office 2010 Tr
#4
Sanırım altın üye olmayanlar pek faydalanamıyor bu yardımlardan. Konuyu çözüm bulamadan kapatıyorum. Saygılar.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
7,755
Beğeniler
297
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#6
Ö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.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
7,755
Beğeniler
297
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#8
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
 
Katılım
9 Temmuz 2004
Mesajlar
384
Beğeniler
0
Excel Vers. ve Dili
Office 2003 Tr & Office 2010 Tr
#9
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ı?
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
7,755
Beğeniler
297
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#10
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
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
25,100
Beğeniler
537
Excel Vers. ve Dili
OFFICE 2019 PRO TR
#14
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
 
Katılım
9 Temmuz 2004
Mesajlar
384
Beğeniler
0
Excel Vers. ve Dili
Office 2003 Tr & Office 2010 Tr
#15
Sayın Korhan Ayhan çok teşekkür ederim. Sorunsuz çalışıyor şimdi Allah razı olsun..
 
Üst