Makroyu hızlandırmak

[Zeki Gürsoy]

Kontrol sayfaları (1,2,3) alt alta birleşse yanlışlık olur mu? Zira her sayfada 280000 data karşılaştırma demek 280000^4 defa döngü demektir. Bundan kurtuluş yok gibi görünüyor.

Sakıncası yoksa büyük dosyayı özelden gönderebilir misiniz?

 

[Orion1]

dosyanızı indiremedim.Hata veriyor.
başka bir yere link yapın.
ben açıklamznızdan bir şey anlamadım.
Bu arada Zeki hocamın söylediğini değerlendirin.O öneride doğrudur.

 

[zaebolll]

Ozel den yolladım link i, inceleyebilir misiniz sizde Zeki Bey.


(Link i kontrol ediyorum.)

 

[Orion1]

Ozel den yolladım link i, inceleyebilir misiniz sizde Zeki Bey.


(Link i kontrol ediyorum.)

Bende zaten özeldeki linki diyorum.O hata veriyor.

 

[zaebolll]

dosyanızı indiremedim.Hata veriyor.
başka bir yere link yapın.
ben açıklamznızdan bir şey anlamadım.
Bu arada Zeki hocamın söylediğini değerlendirin.O öneride doğrudur.

Link çalışıyor, explorer dan kaynalı olabilir belki. Başka bir link e upload ediyorum bitince yollayacağım size tekrardan(4shared)

 

[Zeki Gürsoy]

Kod, özelden verdiğiniz dosyanızdaki sütun konumlarına göredir.

Sub Rapor()
[COLOR=DarkGreen]' Celeron 2.8 RAM 2 GB
' Kayıt Sayısı: MainWork:287333, A_BTS:18251, A_BTS_GPRS:18251, Duzenle:18280
' 281 kayıt / sn işlem hızıyla Toplam 00:17:00[/COLOR]
Dim memMainWork, memA_BTS, memA_BTS_GPRS, memDuzenle, searchKey
Dim L1 As Long, L2 As Integer, L3 As Integer, L4 As Integer
Dim MaxMainWork As Long, MaxA_BTS As Integer, MaxA_BTS_GPRS As Integer, MaxDuzenle As Integer

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    MaxMainWork = Sheet7.Range("g1000000").End(3).Row
    MaxA_BTS = Sheet2.Range("a1000000").End(3).Row
    MaxA_BTS_GPRS = Sheet8.Range("a1000000").End(3).Row
    MaxDuzenle = Sheet5.Range("a1000000").End(3).Row
    
    memMainWork = Sheet7.Range("g2:x" & MaxMainWork).Value
    memA_BTS = Sheet2.Range("a2:er" & MaxA_BTS).Value
    memA_BTS_GPRS = Sheet8.Range("a2:h" & MaxA_BTS_GPRS).Value
    memDuzenle = Sheet5.Range("a2:b" & MaxDuzenle).Value
    
    For L1 = 1 To MaxMainWork - 1
        searchKey = memMainWork(L1, 1)
        For L2 = 1 To MaxA_BTS - 1
            If memA_BTS(L2, 1) = searchKey Then
                memMainWork(L1, 4) = memA_BTS(L2, 49)
                memMainWork(L1, 6) = memA_BTS(L2, 17)
                memMainWork(L1, 10) = memA_BTS(L2, 10)
                memMainWork(L1, 12) = memA_BTS(L2, 9)
                memMainWork(L1, 14) = memA_BTS(L2, 147)
                memMainWork(L1, 16) = memA_BTS(L2, 148)
                Exit For
            End If
        Next
        For L3 = 1 To MaxA_BTS_GPRS - 1
            If memA_BTS_GPRS(L3, 1) = searchKey Then
                memMainWork(L1, 18) = memA_BTS_GPRS(L3, 8)
                Exit For
            End If
        Next
        For L4 = 1 To MaxDuzenle - 1
            If memDuzenle(L4, 1) = searchKey Then
                memMainWork(L1, 8) = memDuzenle(L4, 2)
                Exit For
            End If
        Next
    Next
    
    Sheet7.Range("g2:x" & MaxMainWork) = memMainWork
    
    Erase memMainWork
    Erase memA_BTS
    Erase memA_BTS_GPRS
    Erase memDuzenle
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "İşlem tamamlandı", vbInformation, "::..http://www.excel.web.tr..::"
End Sub

 

[zaebolll]

Arkadaşlar durum şu şekildedir. Bilgilerinize,

* Cells(y, "J") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:AW500000"), 49, 0)
Yukarıdaki şekilde vlookup döngüsüyle 288.000 satırda işlemin tamamlanması 100 dakika sürüyor.


* Korhan beyin ilgili konuda yolladığı ISNA lı vlookup, 280000 satırlı işlemde 140 dakika sürüyor.


* Zeki beyin son yolladığı güncellenmiş ram li makro ise, 280000 satırlı işlemde 35 dakika sürüyor.