Application.SendKeys macromu nasil hizlandirabilirim?

[Mertinc]

Asagida goreceginiz macro, VeriTabani sayfamdaki tabloda C kolonuna gelip, oradaki Filtreden / Ozel Filtre / Iceriyor ve Iceriyor filtresini aciyor. (Custom Filters / Contains and Contains)

Yalniz Application ozelliklerini baslangicta devre disi birakmama ragmen sanki de ScreenUpdating devre disi birakilmamis gibi adim adim nelerin calistigini gorebiliyorum ve nihayetinde cok yavas calisiyor. (Yaklasik 6-7 saniye.)
Tablom 8000 satirlik bir tablo ancak bu basit islemi 7 saniyede tamamlatacak kadar sorun oldugunu dusunmuyorum.
Bu islemi nasil hizlandirabilirim?

Sub showContains()
Dim ws1 As Worksheet, LastRowsOfTable As Long

    With Application
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
 .EnableEvents = False
 .Cursor = xlWait
    End With

Set ws1 = Sheet1
ws1.Activate
ws1.Range("C1").Select       ' <-- Filtre C1'de basladigi icin orayi seciyorum.
LastRowsOfTable = ws1.Cells(Rows.Count, "F").End(xlUp).Row
ActiveWindow.ScrollRow = LastRowsOfTable - 25
        Application.SendKeys "%{DOWN}fa{Tab}{Tab}C{Tab}"

'Select C1 => click ALT+Down Arrow => text filters => contains => and contains

 With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
     .EnableEvents = True
     .Cursor = xlDefault
         End With
    End Sub

 

[Asri]

Bu şekilde dener misiniz?

Sub showContains()
  Dim ws1 As Worksheet, LastRowsOfTable As Long

  With Application
   .ScreenUpdating = False
   .Calculation = xlCalculationManual
   .EnableEvents = False
   .Cursor = xlWait
  End With

  Set ws1 = Sheets("Sayfa1")
  ws1.Activate
  
  sonsatir = ws1.Cells(Rows.Count, "A").End(3).Row
  
  'İçeren kelime yada harfi iki * arasına yazın. Criteria1:="=*C*"  gibi
  'Field:=11  deki 11 sizin filtre uygulayacağınız kolon numarası.  
  
  ActiveSheet.Range("$A$1:$M$" & sonsatir).AutoFilter Field:=11, Criteria1:="=*C*", Operator:=xlAnd

  With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
     .EnableEvents = True
     .Cursor = xlDefault
  End With

End Sub

 

[Mertinc]

Asri Bey ilginiz Icin tesekkurler,

Yalniz arama yapacagim kriterler kod icine tanimlanamazlar cunku farkli kullanicilar farkli kriterlere gore aramalarini yapacaklar. Ayrica karsilarina cikan filtre 2 kriteri ayni and arayabilecekleri bir filtre.

Yoksa sizin onerdiginiz cozum de ayni fonksiyonu yapiyor da ben mi anlayamadim?

 

[Asri]

Asri Bey ilginiz Icin tesekkurler,

Yalniz arama yapacagim kriterler kod icine tanimlanamazlar cunku farkli kullanicilar farkli kriterlere gore aramalarini yapacaklar. Ayrica karsilarina cikan filtre 2 kriteri ayni and arayabilecekleri bir filtre.

Yoksa sizin onerdiginiz cozum de ayni fonksiyonu yapiyor da ben mi anlayamadim?

Ben yanlış anlamışım.

Aşağıdaki şekilde Excel 2010 Türkçe, 11.000 satır veride denendi.
Makro çalıştığında Filtre metin içerir ekranını getirmektedir.

2 sn de içerir ekranını, buraya karakter yazıp tamam dediğinizde 1 sn sonucu veriyor.

Sub showContains()
  Dim ws1 As Worksheet, LastRowsOfTable As Long

  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .Cursor = xlWait
  End With

  Set ws1 = Sheets("Sayfa1")
  ws1.Activate
  ws1.Range("C1").Select       ' <-- Filtre C1'de basladigi icin orayi seciyorum.
  LastRowsOfTable = ws1.Cells(Rows.Count, "F").End(xlUp).Row
  ActiveWindow.ScrollRow = LastRowsOfTable - 25
  'Application.SendKeys "%{DOWN}fa{Tab}{Tab}C{Tab}"
  
  'Excel 2010 TR için
   SendKeys "%{DOWN}f{Tab}{Tab}{Tab}{Tab}"
   SendKeys "{ENTER}"
  'Select C1 => click ALT+Down Arrow => text filters => contains => and contains

   With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
     .EnableEvents = True
     .Cursor = xlDefault
   End With
End Sub

 

[Mertinc]

Asri Bey ilginiz icin tesekkurler, lakin sizin cozumunuzde Contains and Contains degil de sadece tek Contains filtresi aciliyor. Ayrica sayfam tablo seklinde oldugu icin sure yine 4-5 saniye civarinda kaliyor. (Tablo degil de normal girdi seklinde olunca soylediginiz gibi sure dusuyor.)

Ilginc olan Application.ScreenUpdating ozelligi False olmasina ragmen ekrandaki hareketleri tek tek gosteriyor olmasi. Bunun da sebebinin (neden bilmiyorum ama) SendKeys methodu oldugunu dusunuyorum.

 

[Korhan Ayhan]

Aşağıdaki satırı kaldırıp deneyiniz.

ActiveWindow.ScrollRow = LastRowsOfTable - 25

 

[Korhan Ayhan]

Ek olarak örnek dosyayı inceleyiniz.

Sayfada ilk satıra çift tıklayıp arama formunu açıp işlem yapabilirsiniz.

 

[Mertinc]

Korhan Bey ActiveWindow satirini silmem hicbirseyi degistirmiyor maalesef.

Acikcasi benim aklima da Excel'in kendi filtresini kullanmaktansa kendi kullanici formumu olusturup oradan filtre eklemek gelmisti. Hatta su videodaki yontemi izleyecektim:
http://www.onlinepclearning.com/advanced-filters-in-userforms/

Lakin sizin yonteminiz de gayet kolay gibi gozukuyor, yalniz bunu 3,4 kritere cikartmamiz mumkun olur mu acaba?

Case 2 diyerek devam etmeye calistim ama Criteria3'de named argument not found hatasi veriyor. Criteria1 ve Criteria2' nin de biryerde tanimlandigini gormedim ancak niyeyse devam ettiremedim.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet
    
    Set S1 = ActiveSheet
    
    If TextBox1 <> "" Then
        Kriter = Split(TextBox1, ",")
        Select Case UBound(Kriter)
            Case 0
            S1.Range("A1").CurrentRegion.AutoFilter Field:=ActiveCell.Column, Criteria1:="=*" & Kriter(0) & "*", Operator:=xlFilterValues
            Case 1
            S1.Range("A1").CurrentRegion.AutoFilter Field:=ActiveCell.Column, Criteria1:="=*" & Kriter(0) & "*", Operator:=xlFilterValues, Criteria2:="=*" & Kriter(1) & "*"
            Case 2
            S1.Range("A1").CurrentRegion.AutoFilter Field:=ActiveCell.Column, Criteria1:="=*" & Kriter(0) & "*", Operator:=xlFilterValues, Criteria2:="=*" & Kriter(1) & "*", Criteria3:="=*" & Kriter(2) & "*"
        End Select
    End If
End Sub

 

[Korhan Ayhan]

2'den fazla kriter için filtre dışında farklı bir yöntem kullanmak gerekir.

Çünkü özel filtre seçeneğinde en fazla 2 kriter verebiliyorsunuz.

Yardımcı sütun kullanılarak çözüm üretilebilir.

 

[Mertinc]

Anladim Korhan Bey, ben biraz arastirma yapip bir cozum uretmeye calisacagim, insallah sonucu buradan da paylasacagim basarabilirsem. Tesekkurler