makro süzme seçenekleri

igultekin2000 · 10 Nisan 2016

iyi çalışmalar;
siteden bol sütunlu süzme yapan makro buldum. değişik seçenekler sunmasına rağmen ben sadece B sütunundaki, yani İÇİNDE geçen değere göre süzme yapan özelliği kullanmak istiyorum. ilgili makroyu her sütun için kopyala-yapıştır la yapmayı denedim olmadı, numune makrosundaki B sütunundaki özelliği diğer sütunlara da uygulamak mümkün mü ? saygılar

http://www.dosya.tc/server7/7yobqx/NUMUNE.rar.html

Vedat Özer · 10 Nisan 2016

Selamlar,

Koddaki renkli kısmın başına "*"& ve sonuna &"*" eklerseniz istediğiniz olcaktır.
B Sütunundaki textbox olan kodlar.

Kod:

Private Sub TextBox2_Change()
On Error Resume Next
METİN1 = TextBox2.Value
Set FC2 = Range("B7:J65000").Find(What:=METİN1)
Application.Goto Reference:=Range(FC2.Address), _
   Scroll:=False
Selection.AutoFilter Field:=2, Criteria1:=[COLOR="RoyalBlue"]"*" &[/COLOR] TextBox2.Value [COLOR="royalblue"]& "*"[/COLOR]
If METİN1 = "" Then
Selection.AutoFilter Field:=2
End If

End Sub

igultekin2000 · 10 Nisan 2016

her textBox

Vedat Özer' Alıntı:
Selamlar,

Koddaki renkli kısmın başına "*"& ve sonuna &"*" eklerseniz istediğiniz olcaktır.
B Sütunundaki textbox olan kodlar.

Kod:

Private Sub TextBox2_Change() On Error Resume Next METİN1 = TextBox2.Value Set FC2 = Range("B7:J65000").Find(What:=METİN1) Application.Goto Reference:=Range(FC2.Address), _ Scroll:=False Selection.AutoFilter Field:=2, Criteria1:=[COLOR="RoyalBlue"]"*" &[/COLOR] TextBox2.Value [COLOR="royalblue"]& "*"[/COLOR] If METİN1 = "" Then Selection.AutoFilter Field:=2 End If

End Sub

istediğim fonksiyon B sütünunda çalışıyor, ben diğer sütünlardada aynı fonksiyonun çalışmasına çalışıyorum. dediğiniz ilaveleri diğerlerininde içine yazdım ama sadece biri daha o özellikte çalışmaya başladı.

PLİNT · 10 Nisan 2016

Merhaba
Alternatif olarak,filtre kullanmadan;
http://s8.dosya.tc/server2/5iy2b7/Xl0000010.zip.html

Kod:

Private Sub TextBox2_Change()
Application.ScreenUpdating = False
a = Cells(Rows.Count, 1).End(3).Row
METİN1 = TextBox2.Value
If METİN1 = "" Then
Cells.EntireRow.Hidden = False
Else
Rows("3:" & a).Hidden = True
End If
With Range("B3:J65000")
Set c = .Find(METİN1, LookIn:=xlFormulas)
If Not c Is Nothing Then
ilk = c.Address
Do
Rows(c.Row).EntireRow.Hidden = False
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While Not c Is Nothing And c.Address <> ilk
End If
End With
Application.ScreenUpdating = True
End Sub

igultekin2000 · 10 Nisan 2016

Makro

PLİNT' Alıntı:

Merhaba
Alternatif olarak,filtre kullanmadan;
http://s8.dosya.tc/server2/5iy2b7/Xl0000010.zip.html

Kod:

Private Sub TextBox2_Change()
Application.ScreenUpdating = False
a = Cells(Rows.Count, 1).End(3).Row
METİN1 = TextBox2.Value
If METİN1 = "" Then
Cells.EntireRow.Hidden = False
Else
Rows("3:" & a).Hidden = True
End If
With Range("B3:J65000")
Set c = .Find(METİN1, LookIn:=xlFormulas)
If Not c Is Nothing Then
ilk = c.Address
Do
Rows(c.Row).EntireRow.Hidden = False
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While Not c Is Nothing And c.Address <> ilk
End If
End With
Application.ScreenUpdating = True
End Sub

öncekinden çok daha güzel ve kullanışlı olmuş, teşekkür ederim, bir de satır sayısı çok fazla olduğu için hazırlanan forma mesela 191 00 08 seçtiğimde o satırlar geliyor veya 391 00 18 yazınca o satırlar geliyor, bunları kullanmıyorum. veri fazla olduğu için yavaşlatıyor, bu şekilde seçili hale getirdiğim satırları gene makro yardımıyla kalıcı sildirmem mümkün olabilir mi?

ASMET67 · 17 Haziran 2016

Merhaba
Filtresiz alternatif koda 2. metin eklediğimizde nasıl bir değişiklik yapmamamız gerekir.

alicimri · 17 Haziran 2016

Filitrelerken;
Özelde eşit veya içerir seçin
İki ayrı kelime için
*ilkkelime**ikincikelime* şeklinde
Üç ayrı kelime için
*ilkkelime**ikincikelime**Üçüncükelime* şeklinde
..................
yazıp filtreleyin

alicimri · 17 Haziran 2016

Kodlu örnek B1 hücresine bir kelimenin tamamını veya bir bölümünü yazarak veya aralarına boşluk koyarak 2 veya daha fazla kelimeyi filitreliyebilirsiniz

Kod:

Sub suz()
METİN = "*" & Replace(Range("b1"), " ", "**") & "*"
Range("B2").AutoFilter Field:=2, Criteria1:=METİN
End Sub

ASMET67 · 17 Haziran 2016

Aşağıdaki kodda metin 1 a sütununda metin 2 b sütununda ve metin 3 c sütununda olursa kodu nasıl revize edebiliriz

Kod:

Private Sub TextBox2_Change()
Application.ScreenUpdating = False
a = Cells(Rows.Count, 1).End(3).Row
METİN1 = TextBox2.Value
If METİN1 = "" Then
Cells.EntireRow.Hidden = False
Else
Rows("3:" & a).Hidden = True
End If
With Range("B3:J65000")
Set c = .Find(METİN1, LookIn:=xlFormulas)
If Not c Is Nothing Then
ilk = c.Address
Do
Rows(c.Row).EntireRow.Hidden = False
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
Loop While Not c Is Nothing And c.Address <> ilk
End If
End With
Application.ScreenUpdating = True
End Sub

alicimri · 17 Haziran 2016

üç ayrı find olayı aynı anda çalışmaz gibi geliyor bana
normal döngüye sokup üç sütunda üç ayrı şartın oluştuğu satırların dışındakileri gizleyeceksiniz.
yada filter olayını üç sütun için sırayla çalıştıracaksınız

igultekin2000 · 20 Haziran 2016

alicimri' Alıntı:
üç ayrı find olayı aynı anda çalışmaz gibi geliyor bana
normal döngüye sokup üç sütunda üç ayrı şartın oluştuğu satırların dışındakileri gizleyeceksiniz.
yada filter olayını üç sütun için sırayla çalıştıracaksınız

http://s5.dosya.tc/server2/tz01et/YENI_SUZME.xls.html

formlarda kasmayan işlem buldum onu kullanıyorum,
teşekkürler