• DİKKAT

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

Makro hizli calismasi hk.

Katılım
23 Şubat 2007
Mesajlar
131
Excel Vers. ve Dili
excel2003
Merhaba arkadaşlar saygı değer hocalarım
Excelde oluşturduğum makromun daha hızlı çalışması için nasıl bir yol çizmek gerekli yardımcı olurmusunuz.şimdiden çok Tesekkurler.dosyam aşağıdaki linktedir.

http://www.dosyaupload.com/4Ecj
 
Bu şekilde dener misiniz?


Kod:
Sub kod()
  On Error Resume Next
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set x = ThisWorkbook.Sheets(1)
  Set ktp = Workbooks.Open(ThisWorkbook.Path & "\" & x.ComboBox1.Text)
  Set xx = ktp.Sheets(1)

  son = xx.Cells(65536, "A").End(xlUp).Row + 1
  xx.Range("A2" & ":C" & son - 1).Select
  Selection.Sort Key1:=xx.Range("A2"), Order1:=xlDescending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  DataOption1:=xlSortNormal


  ThisWorkbook.Activate
  For v = 1 To 30
   If Mid(x.Cells(1, v), 2, 3) = Mid(x.ComboBox1.Value, 5, 3) Or Mid(x.Cells(1, v), 1, 3) = Mid(x.ComboBox1.Value, 4, 3) Then
     If x.Cells(4, v).Value > 0 And x.Cells(4, v + 1).Value > 0 And x.Cells(5, v).Value > 0 And x.Cells(5, v + 1).Value > 0 Then
         If onay = MsgBox("Hücrede veri var!Tekrar yüklenmesini istermisiniz? ", vbYesNo + vbQuestion) = vbNo Then Exit Sub
            onay = vbYes
            GoTo d:
     Else
d:
       For k = 4 To x.Cells(65536, "A").End(xlUp).Row
         If WorksheetFunction.CountIf(xx.Range("A2:A" & i), x.Cells(k, "A")) >= 1 Then
           x.Cells(k, v) = WorksheetFunction.SumIf(xx.Range("A2:A" & son), "=" & x.Cells(k, "A"), xx.Range("C2:C" & son))
           x.Cells(k, v + 1) = WorksheetFunction.SumIf(xx.Range("A2:A" & son), "=" & x.Cells(k, "A"), xx.Range("B2:B" & son))
         End If
       Next k
     End If
   End If
  Next v

'Workbooks(yol).Close True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
(benim bilgisayarda ortalama 3 dk sürüyor kodun çalışması :) )
yapılması gereken en temel iki ayarlamayı yapmışsın.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

tavsiye edebileceğim noktalar ise:
iç içe 4-5 tane FOR döngülerin var. yapman gereken bunları bir şekilde iyileştirip, daha kısa yoldan çözümü bulmak olacaktır. çünkü iç içe döngüler katlanarak hesaplandığı için çok fazla zaman alır.

bir diğer hususta çalışma sayfalarıyla çalışırken komple sayfa nesnesini kullanmakta sizi baya yavaşlatır. bunun yerine çalışma sayfasındaki verileri belleğe alıp, bunun üzerinde işlemlerinizi yaptıktan sonra bellekten sayfaya verileri geri yüklemek olacaktır.
bunun için şu sayfadaki ayrıntılı örnekleri inceleyiniz.
http://www.cpearson.com/excel/ArraysAndRanges.aspx

son olarakta şu sayfadaki tavsiyeleri gözden geçiriniz.
http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm
 
Öneri: Her gün için ayrı Excel dosyası oluşturmak yerine, dördüncü sütun oluşturup bu sütuna tarihi yazın ve bütün verileri alt alta yazın/yapıştırın.
Özet tablo oluşturup
Sütun Etiketi : oluşturduğunuz "tarih" sütununu
Satır Etiketi : "Parça" sütunu
Değer Etiket: "Çalışma Süresi", "Net Üretim" olarak ayarlayın.
 
Tesekkurler sayın Asri hocam ,diğer arkadaşlarin dediği gibi revize edecem.
 
Geri
Üst