Makroyu Daha Hızlı Nasıl Yapabiliriz?

[ormann]

Merhabalar;
Aşağıda ki makronun daha hızlı bir şekilde çalışması için ne yapabiliriz?

Private Sub CommandButton118_Click() 'TÜM
Set sh1 = Sheets("KAYIT")
Set sh2 = Sheets("DURUŞMALAR")
Set sh3 = Sheets("DETAYLI DAVA TAKİP")
baslangıc = sh3.Cells(48, "F").Value
bitis = sh3.Cells(48, "G").Value
sh2.Range("A2:M65000").ClearContents
deg1 = CDate(baslangıc)
deg2 = CDate(bitis)
sat = 2
If deg1 <= deg2 Then
yer1 = baslangıc
Else
yer1 = bitis
End If
If IsDate(baslangıc) = True Then
If IsDate(bitis) = True Then
For r = 0 To Val(bitis - baslangıc)
deg = yer1 + r
For i = 2 To sh1.Cells(Rows.Count, "a").End(3).Row
If CDate(deg) = CDate(sh1.Cells(i, "by").Value) Then
sh2.Cells(sat, "A").Value = sh1.Cells(i, "BY").Value
sh2.Cells(sat, "B").Value = sh1.Cells(i, "A").Value
sh2.Cells(sat, "C").Value = sh1.Cells(i, "B").Value
sh2.Cells(sat, "D").Value = sh1.Cells(i, "C").Value
sh2.Cells(sat, "E").Value = sh1.Cells(i, "D").Value
sh2.Cells(sat, "F").Value = sh1.Cells(i, "E").Value
sh2.Cells(sat, "G").Value = sh1.Cells(i, "F").Value
sh2.Cells(sat, "H").Value = sh1.Cells(i, "L").Value
sh2.Cells(sat, "I").Value = sh1.Cells(i, "Q").Value
sh2.Cells(sat, "J").Value = sh1.Cells(i, "AR").Value
sh2.Cells(sat, "K").Value = sh1.Cells(i, "BW").Value
sh2.Cells(sat, "L").Value = sh1.Cells(i, "BX").Value
sh2.Cells(sat, "M").Value = sh1.Cells(i, "AP").Value
sh2.Cells(sat, "N").Value = sh1.Cells(i, "AM").Value
sat = sat + 1
End If
Next
Next
End If
End If
son = Sayfa22.Range("C65536").End(3).Row
        Sayfa22.PageSetup.PrintArea = "$A$1:$N$" & son
        Hide
        Beep
        Sayfa22.PrintPreview
        UserForm3.Show
End Sub

 

[Korhan Ayhan]

Merhaba,

Kodlarınızdan anladığım kadarıyla tarih aralığına göre veri listeliyorsunuz. Bu işlemi filtre özelliğini kullanarak yaparsanız verileri daha hızlıca yönetebilirsiniz. Döngü yöntemine göre daha hızlı sonuç alabilirsiniz. Bunun için örnek dosya eklerseniz yardım almanız kolaylaşır.