3 farlı kritere göre otomatik filtreleme

[ozgurerturk]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
    Range("A4:C1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:G2"), Unique:=False
End Sub

Bu kodda garip bir sorunla karşılaştım. Filtrelemeler harika çalışıyor kopyala yapıştır ve tek tek girerek filtre yapabiliyorum ancak filtreledikten sonra E2,F2,G2 hücrelerdeki verileri silmemle tablo eski haline çok geç dönüyor, yeni filtre uygulamak için 1 dk nın üzerinde beklemeniz gerekiyor. Ben bu kodu 10.000 satırlı excel de kullanıyorum. Bunun için bişey yapılabilir mi?

 

[veyselemre]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
    If Join(Application.Index((Range("E2:G2").Value), 0), "") = "" Then Range("A4:C4").AutoFilter
    Range("A4:C1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:G2"), Unique:=False
End Sub

 

[ozgurerturk]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
    If Join(Application.Index((Range("E2:G2").Value), 0), "") = "" Then Range("A4:C4").AutoFilter
    Range("A4:C1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:G2"), Unique:=False
End Sub

Düzeldi, hızlı çalışıyor. Teşekkürler