• DİKKAT

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

Makroyu hızlandırma

recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Arkadaşlar bir makro kodu yazdım kod biraz uzun sanırım bu yüzden makronun çalışması uzun sürüyor. Sormak istediğim makronun çalışmasının uzun sürmesi yazılan kodun uzunluğuyla alakası var mı ? Yoksa kodun içerisinde yanlış yaptığım başka bir şeylerden mi kaynaklanıyor ? Makroyu aşağıda paylaştım. 3 makro da birbirine bağlantılı.
Kod: 
Sub Wpkaydet1()


    Range("B8:X61").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ActiveWorkbook.Save
    Application.OnTime Now + TimeValue("00:00:00"), "mesaj"
End Sub
Kod: 
Sub Mesaj()


    Range("AI7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("CK7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("EM7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("GO7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("IQ7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("KS7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("MU7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("OW7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("QY7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("TA7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("VC7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("XE7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("ZG7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("ABI7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("ADK7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("AFM7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("AHO7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("AJQ7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("ALS7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("ANU7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("APW7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("ARY7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("AUA7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("AWC7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("AYE7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("BAG7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("BCI7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("BEK7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("BGM7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("BIO7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Range("BKQ7").FormulaR1C1 = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Application.OnTime Now + TimeValue("00:00:03"), "mesajsil"
    
End Sub
Kod: 
Sub Mesajsil()


    Range("AI7").FormulaR1C1 = ""
    Range("CK7").FormulaR1C1 = ""
    Range("EM7").FormulaR1C1 = ""
    Range("GO7").FormulaR1C1 = ""
    Range("IQ7").FormulaR1C1 = ""
    Range("KS7").FormulaR1C1 = ""
    Range("MU7").FormulaR1C1 = ""
    Range("OW7").FormulaR1C1 = ""
    Range("QY7").FormulaR1C1 = ""
    Range("TA7").FormulaR1C1 = ""
    Range("VC7").FormulaR1C1 = ""
    Range("XE7").FormulaR1C1 = ""
    Range("ZG7").FormulaR1C1 = ""
    Range("ABI7").FormulaR1C1 = ""
    Range("ADK7").FormulaR1C1 = ""
    Range("AFM7").FormulaR1C1 = ""
    Range("AHO7").FormulaR1C1 = ""
    Range("AJQ7").FormulaR1C1 = ""
    Range("ALS7").FormulaR1C1 = ""
    Range("ANU7").FormulaR1C1 = ""
    Range("APW7").FormulaR1C1 = ""
    Range("ARY7").FormulaR1C1 = ""
    Range("AUA7").FormulaR1C1 = ""
    Range("AWC7").FormulaR1C1 = ""
    Range("AYE7").FormulaR1C1 = ""
    Range("BAG7").FormulaR1C1 = ""
    Range("BCI7").FormulaR1C1 = ""
    Range("BEK7").FormulaR1C1 = ""
    Range("BGM7").FormulaR1C1 = ""
    Range("BIO7").FormulaR1C1 = ""
    Range("BKQ7").FormulaR1C1 = ""
    
End Sub
 
Örnek dosyaları gönderebilir misiniz.
 
görebildiğim kadarı ile kodlardınızda uzun çalışma gerektiren bir durum yok.
bir ihtimal ekranı clipboard'a kopyalaması süreyi uzatıyordur.

ayrıca tek bir kod ihtiyacınızı görmeye yeterli.
aşağıdaki 1 saniye bile sürmedi:

Kod: 
Sub Wpkaydet1()

    Dim hcr
    Dim i As Long
    
    hcr = Array("AI7", "CK7", "EM7", "GO7", "IQ7", "KS7", "MU7", "OW7", "QY7", "TA7", "VC7", "XE7", "ZG7", "ABI7", "ADK7", "AFM7", "AHO7", "AJQ7", "ALS7", "ANU7", "APW7", "ARY7", "AUA7", "AWC7", "AYE7", "BAG7", "BCI7", "BEK7", "BGM7", "BIO7", "BKQ7")
    
    Range("B8:X61").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ActiveWorkbook.Save
    
    For i = LBound(hcr) To UBound(hcr)
        Range(hcr(i)).Value = "Rapor kopyalandı. Whatsap üzerinden CTRL+V yaparak gönderebilirsiniz."
    Next i

    Application.Wait Now + TimeValue("00:00:03")
    
    For i = LBound(hcr) To UBound(hcr)
        Range(hcr(i)).ClearContents
    Next i

End Sub
 
öte yandan 31 adet hücreye veri yazdırıp 3 saniye sonra siliyorsunuz. kullanıcının bunu fark etmesi dahi zor.
gereksiz.

kısacası aşağıdaki kod ile önceki mesajımdaki kod arasında işlevsel olarak bir fark yok.

Kod: 
Sub Wpkaydet1()

    Range("B8:X61").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ActiveWorkbook.Save
    
End Sub
 
Hücre adreslerini tek tek yazdıktan sonra döngüsüz çalışır.
Kod: 
Range("$AI$7,$CK$7,$EM$7,$GO$7,$IQ$7,$KS$7,$MU$7,$OW$7,$QY$7,$TA$7,$VC$7,$XE$7,$ZG$7,$ABI$7,$ADK$7,$AFM$7,$AHO$7,$AJQ$7,$ALS$7,$ANU$7,$APW$7,$ARY$7,$AUA$7,$AWC$7,$AYE$7,$BAG$7,$BCI$7,$BEK$7,$BGM$7,$BIO$7,$BKQ$7").ClearContents

Döngü için
Kod: 
    For I = 35 To 1655 Step 54
        Cells( 7,I).ClearContents
    Next I
 
@mancubus hocam kod için teşekkür ederim. Sormak istediğim bir şey daha var. Yazdığınız kod için çalışma süresi 1 saniye bile sürmedi demişsiniz. Application.Wait Now + TimeValue("00:00:03") komutu sizi 3 saniye bekletmiyor mu ?
 
normal kodun çalışma süresi olarak düşünün
wait bizim müdahalemiz


Sent from my iPhone using Tapatalk
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst