• DİKKAT

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

Süzme makrosu rakam sorunu

Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
iyi günler; pratik olarak kullanılan süzme makrosu metinlerde sorunsuz çalışıyor ancak sayı kısmında kullanmak istediğimde çalışmıyor. rakamı metne çevirince sorunsuz çalışıyor. bu makrosu rakamla da kullanmak istiyorum.
Kod:
Private Sub TextBox1_Change()

Selection.AutoFilter Field:=9, Criteria1:="*" & TextBox1.Value & "*"
son = Cells(Rows.Count, "a").End(3).Row 'son dolu hücre
[C2] = Cells(son, "I")
End Sub
 

Ekli dosyalar

  • suzme.jpg
    suzme.jpg
    335.7 KB · Görüntüleme: 1
  • ornek_suzme.xlsm
    ornek_suzme.xlsm
    22.6 KB · Görüntüleme: 8
D kolonunda textbox1 var sayılmıştır.

Bu şekilde deneyiniz.

Değer büyük yada eşit ise >=
Küçük yada eşit ise <=
Eşit ise =


Kod:
Private Sub TextBox1_Change()
   On Error Resume Next
   ShowAllData
   On Error GoTo 0
   sonsatir = ActiveSheet.UsedRange.Rows.Count + 1
   If TextBox1.Value <> "" Then Range("$A$3:$F$" & sonsatir).AutoFilter Field:=4, Criteria1:=">=" & TextBox1.Value
End Sub
 
Sayısal ifadelerde başlayan filtresi olmaz. Aşağıdaki şekilde belki işinize yarar.
Kod:
Private Sub TextBox2_Change()
On Error Resume Next
UNI = TextBox2.Text
Set FC2 = Range("A3:I65000").Find(What:=UNI)
Application.GoTo Reference:=Range(FC2.Address), Scroll:=False
Selection.AutoFilter field:=4, Criteria1:=">=" & UNI
If UNI = "" Then
    Selection.AutoFilter field:=4
End If
End Sub
 
Sorunsuz çalışıyor

Sayısal ifadelerde başlayan filtresi olmaz. Aşağıdaki şekilde belki işinize yarar.
Kod:
Private Sub TextBox2_Change()
On Error Resume Next
UNI = TextBox2.Text
Set FC2 = Range("A3:I65000").Find(What:=UNI)
Application.GoTo Reference:=Range(FC2.Address), Scroll:=False
Selection.AutoFilter field:=4, Criteria1:=">=" & UNI
If UNI = "" Then
    Selection.AutoFilter field:=4
End If
End Sub

elinize sağlık, gayet sorunsuz çalışıyor. teşekkürler.
 
Rica ederim. Kolay gelsin.
 
Geri
Üst