Makroyu hızlandırma

[recepkull]

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ı.

Sub Wpkaydet1()


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

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

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

 

[Erdem Akdemir]

Örnek dosyaları gönderebilir misiniz.

 

[mancubus]

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:

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

 

[mancubus]

ö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.

Sub Wpkaydet1()

    Range("B8:X61").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ActiveWorkbook.Save
    
End Sub

 

[mancubus]

hatırlatma:
sorunuz makro çözümü içeriyor.
aşağıdaki forumda açılmalıydı:
https://www.excel.web.tr/forums/makro-vba-sorulari.48/

 

[veyselemre]

Hücre adreslerini tek tek yazdıktan sonra döngüsüz çalışır.

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

    For I = 35 To 1655 Step 54
        Cells( 7,I).ClearContents
    Next I

 

[recepkull]

@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 ?

 

[mancubus]

normal kodun çalışma süresi olarak düşünün
wait bizim müdahalemiz


Sent from my iPhone using Tapatalk