• DİKKAT

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

Makroyu hızlandırmak

Z

zaebolll

Katılım
17 Şubat 2009
Mesajlar
29
Excel Vers. ve Dili
2003
Merhaba arkadaşlar, yardımcı olabilir misiniz. Ekteki excel de data verilerinin coğunu sildim upload limitinden.

Vlookup kismi cok zaman aliyor satir sayisinin cok fazla olmasindan, sabredip bekleyemedim ama tahminen 2 saate yakın sürecek gibi gozukuyor aranan değerlerin işlenmesi.(287000 küsür satirda işlem yapılıyor.)

VBA da yardımcı olmanızı istedigim kodlar "module 2" de yer alıyor.(Menu de Button 5 e tanımlanan kodlar.)

Dim x As Long
Dim y As Long
On Error Resume Next
x = Cells(500000, "G").End(xlUp).Row
For y = 2 To x
If Cells(y, "J") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:AW500000"), 49, 0) = "" Then
Cells(y, "J") = "YOK"
Else

Cells(y, "J") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:AW500000"), 49, 0)
Cells(y, "L") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:Q500000"), 17, 0)
Cells(y, "P") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:J500000"), 10, 0)
Cells(y, "R") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:I500000"), 9, 0)
Cells(y, "T") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:EQ500000"), 147, 0)
Cells(y, "V") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS").Range("A2:ER500000"), 148, 0)
Cells(y, "N") = WorksheetFunction.VLookup(Range("G" & y), Sheets("Duzenle").Range("A2:B500000"), 2, 0)
Cells(y, "X") = WorksheetFunction.VLookup(Range("G" & y), Sheets("A_BTS_GPRS").Range("A2:H500000"), 8, 0)
End If
Next y

Yardımcı olabilirseniz sevinirim, farklı bir formulasyonda önerebilirsiniz. Şimdiden çok teşekkürler ayıracağınız vakit için.
 

Ekli dosyalar

A_ADCE sayfasından kopyaladığınız verilen kodlarını değiştirmeniz gerekmektedir.
VLookup ile alakalı olmadığıız düşünüyorum.

İyi Çalışmalar.
 
Teşekkürler Rebiwar cevabın için.


A_ADCE den MainWork e kopyalanan veri kısmında sorun yok.


Sorun vlookup kısmına geçince cok vakit almasi(280000 küsürden fazla satir için uygulamakta.)

Mesela 6 kolonun herbiri için A_BTS e ayrı ayrı vlookup çekiyorum. Bunu offsetlerle veya farklı formulasyonlarla düşürebilir miyiz.

(Makro bu haliyle doğru çalışıyor fakat çok vakit harcıyor vlookup kısmında. 2 saate yakın. Bir şeyleri yanlış yapıyorum ve bu süreyi kısaltmamda yardımcı olur musunuz.)
 
İşlemi Access de sql ile yapmanız daha uygun görünüyor.

Bir mdb örneğini eklerseniz, nasıl bir sonuç görmek istediğinizi de detaylı yazarsanız belki daha hızlı bir metot bulunabilir.
 
ReBiwAr' Alıntı:
A_ADCE sayfasından kopyaladığınız verilen kodlarını değiştirmeniz gerekmektedir.
VLookup ile alakalı olmadığıız düşünüyorum.

İyi Çalışmalar.
Genişletmek için tıkla ...

Sn. ReBiwAr, Vlookup fonksiyonu 287.000 X 9 kez çalışıyor.
 
Sayın arkadaşlar, excel üzerinden yapabilirsek ne mutlu. Ben örneğin dahada belirgin olması için başka bir excel koydum ek'e. Eğer benle ilgili kodları paylaşabilirseniz bende bunu kendime göre uyarlayacağım.

İstediğim, örnek excel de, "işlem" sayfasında mevcut değerlerim var.
"kontrol1", "kontrol2" ve "kontrol3" sayfalarında ise aslında olmaları gereken gerçek değerlerim var.

Ben Target isimlerine gore bu değerlerin, "işlem" sayfasında mevcut değerlerin yanına, diğer kontrol sayfalarından olması gereken değerlerin yazılmasını istiyorum.

Sadece belirttiğim gibi "işlem" sayfasında örnek için 4 target koysamda, gerçekte satır sayısı çok fazla.(287000 küsür ve bu sayı ileride artabilir.) Çok fazla zaman harcamadan excel üzerinden istemiş olduğum bu işlemin yapılabilme şansı var mıdır arkadaşlar?

Tekrardan çok teşekkürler.
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Aşağıdaki kod ile örnek dosyanızda 65000 satır üzerinde denedim. Yaklaşık 11 saniye sürdü.

Sizde deneyip sonucu bildirirmisiniz.

Kod: 
Option Explicit
 
Sub VBA_HIZLI_DÜŞEYARA()
    Dim Satır As Long, Zaman As Date
    
    Zaman = Time
    
    On Error GoTo Son
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    With Sheets("İslem")
         Satır = .Cells(Rows.Count, 1).End(3).Row
        .Range("C2:C" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol1!A:G,2,0)),"""",VLOOKUP(A2,Kontrol1!A:G,2,0))"
        .Range("E2:E" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol1!A:G,3,0)),"""",VLOOKUP(A2,Kontrol1!A:G,3,0))"
        .Range("G2:G" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol1!A:G,4,0)),"""",VLOOKUP(A2,Kontrol1!A:G,4,0))"
        .Range("I2:I" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol1!A:G,5,0)),"""",VLOOKUP(A2,Kontrol1!A:G,5,0))"
        .Range("K2:K" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol1!A:G,6,0)),"""",VLOOKUP(A2,Kontrol1!A:G,6,0))"
        .Range("M2:M" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol1!A:G,7,0)),"""",VLOOKUP(A2,Kontrol1!A:G,7,0))"
        .Range("O2:O" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol2!A:B,2,0)),"""",VLOOKUP(A2,Kontrol2!A:B,2,0))"
        .Range("Q2:Q" & Satır) = "=IF(ISNA(VLOOKUP(A2,Kontrol3!A:B,2,0)),"""",VLOOKUP(A2,Kontrol3!A:B,2,0))"
        
        .Range("C2:C" & Satır).Value = .Range("C2:C" & Satır).Value
        .Range("E2:E" & Satır).Value = .Range("E2:E" & Satır).Value
        .Range("G2:G" & Satır).Value = .Range("G2:G" & Satır).Value
        .Range("I2:I" & Satır).Value = .Range("I2:I" & Satır).Value
        .Range("K2:K" & Satır).Value = .Range("K2:K" & Satır).Value
        .Range("M2:M" & Satır).Value = .Range("M2:M" & Satır).Value
        .Range("O2:O" & Satır).Value = .Range("O2:O" & Satır).Value
        .Range("Q2:Q" & Satır).Value = .Range("Q2:Q" & Satır).Value
    End With
 
Son:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
    "İşlem süresi ; " & Format(Now - Zaman, "hh:mm:ss"), vbInformation
End Sub
 
Korhan bey dediğimi anlamış ve çözmüş görünüyor..
Teşekkürler
 
Oldukça başarılı Korhan bey. Ben sorgunun Access te olmasını tercih ederdim.

Kod: 
SELECT
 İslem.Target , İslem.mevcut1, Kontrol1.[olmasi gereken1],
 İslem.mevcut2 , Kontrol1.[olmasi gereken2], İslem.mevcut3,
 Kontrol1.[olmasi gereken3] , İslem.mevcut4, Kontrol1.[olmasi gereken4],
 İslem.mevcut5 , Kontrol1.[olmasi gereken5], İslem.mevcut6,
 Kontrol1.[olmasi gereken6] , İslem.mevcut7, Kontrol2.[olmasi gereken7],
 İslem.mevcut8 , Kontrol3.[olmasi gereken8]
FROM ((İslem
 LEFT JOIN Kontrol1 ON İslem.Target = Kontrol1.Target)
 LEFT JOIN Kontrol2 ON İslem.Target = Kontrol2.Target)
 LEFT JOIN Kontrol3 ON İslem.Target = Kontrol3.Target;
 

Ekli dosyalar

Korhan Ayhan' Alıntı:
Merhaba,

Aşağıdaki kod ile örnek dosyanızda 65000 satır üzerinde denedim. Yaklaşık 11 saniye sürdü.

Sizde deneyip sonucu bildirirmisiniz.
Genişletmek için tıkla ...

Merhaba Korhan Bey, maalesef 65000 satırda 13 dakika 53 saniye sürdü.

287 bin küsür satırda yarım saati geçti halen makro çalışıyor. (Makro ya break veremiyorum yada sonlandıramıyorum çalıştıktan sonra, yapmaya çalışırsam excel yanıt vermiyor.)

Tavsiyeleriniz çok makbul geçer. Şimdiden teşekkürler.
 
Zeki Gürsoy' Alıntı:
Oldukça başarılı Korhan bey. Ben sorgunun Access te olmasını tercih ederdim.
Genişletmek için tıkla ...

Zeki Bey teşekkürler, excel üzerinden de önerebileceğiniz şeyler olursa inanın benim için daha makbül geçer. Hazırladığınız access e excel i dahi import edebilecek access bilgim yok. İlaveten işlem/kontrol döngüsünden önce ham data bu hale getirilirken bazı işlemlerden geçiyor. Bunlarında access e eklenmesi gerekecek...
 
Tekrar merhaba,

Aklıma excel için en hızlı yöntem RAM gibi görünüyor. Çünkü excel için en iyisi bu.

Ne kadar süreceğini bilemiyorum. Biraz sonra eklerim.
 
Gerçek verilerinizi ekli dosyaya kopyalayıp deneyin.
Süreyi bildirirseniz memnun olurum.

Kod: 
Option Explicit

Sub test()
Dim memKontrol, memKontrol1, memKontrol2, memKontrol3
Dim iUst As Long, kUst1 As Long, kUst2 As Long, kUst3 As Long
Dim L As Long, L1 As Long, L2 As Long, L3 As Long
Dim t1 As Single, t2 As Single

    t1 = Timer
    
    With Application
        .Caption = "~~~ Bekleyin... ~~~"
        .Windows(ActiveWindow.WindowNumber).Caption = "~~~ İşlem başladı... ~~~ "
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    iUst = Sheet2.Range("a1000000").End(3).Row
    kUst1 = Sheet3.Range("a1000000").End(3).Row
    kUst2 = Sheet4.Range("a1000000").End(3).Row
    kUst3 = Sheet5.Range("a1000000").End(3).Row
    
    memKontrol = Sheet2.Range("a2:q" & iUst).Value
    memKontrol1 = Sheet3.Range("a2:g" & kUst1).Value
    memKontrol2 = Sheet4.Range("a2:b" & kUst2).Value
    memKontrol3 = Sheet5.Range("a2:b" & kUst3).Value
       
        For L = 1 To iUst - 1
            For L1 = 1 To kUst1 - 1
                If memKontrol(L, 1) = memKontrol1(L1, 1) Then
                    memKontrol(L, 3) = memKontrol1(L1, 2)
                    memKontrol(L, 5) = memKontrol1(L1, 3)
                    memKontrol(L, 7) = memKontrol1(L1, 4)
                    memKontrol(L, 9) = memKontrol1(L1, 5)
                    memKontrol(L, 11) = memKontrol1(L1, 6)
                    memKontrol(L, 13) = memKontrol1(L1, 7)
                End If
            Next
            For L2 = 1 To kUst2 - 1
                If memKontrol(L, 1) = memKontrol2(L2, 1) Then
                    memKontrol(L, 15) = memKontrol2(L2, 2)
                End If
            Next
            For L3 = 1 To kUst3 - 1
                If memKontrol(L, 1) = memKontrol3(L3, 1) Then
                    memKontrol(L, 17) = memKontrol3(L3, 2)
                End If
            Next
        Next
    
    t2 = Timer
    
    Sheet2.Range("a2:q" & iUst) = memKontrol
    
    Erase memKontrol
    Erase memKontrol1
    Erase memKontrol2
    Erase memKontrol3
    
    With Application
        .Caption = Application.Name
        .Windows(ActiveWindow.WindowNumber).Caption = ThisWorkbook.Name
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    MsgBox "Geçen süre : " & Format((t2 - t1) \ 60, _
            "00") & ":" & Format((t2 - t1) Mod 60, "00")
End Sub
 

Ekli dosyalar

Son düzenleme:
Merhaba Zeki Bey,

Gece yatmadan makronuzu çalıştırdım. Bilgisayarın güç ayarlarından standby a geçmesini ve harddisk in durdurulmasini 5 saate çıkardım.

Sabah kalktığımda bu 5 saat içinde makro bitmemiş maalesef. 157 bin küsürüncü satırlardaymış.

Şimdi bilgisayara reset atıp tekrardan kod larınızı koşturacağım.
 
Merhaba,

Eğer sakıncası yoksa hem 65000 satırlık hemde 290000 satırlık dosyalarınızı özelden mail atabilirmisiniz.

Birde kullandığınız bilgisayarınızın özelliklerini yazabilirmisiniz.
 
Merhaba arkadaşlar, artık son çırpınışlarım :) Çok satırlı excel de makro nun yavaşlığına pes etmek üzereyim. Öncelikle yardımcı olmaya çalışan arkadaşlara tekrardan teşekkür ederim.

Elimde 280.000 satırı aşan kontrol edilecek bir sayfa var. Ve kendi çabam ile uyguladığım yada önerilen kodları uyguladığım makrolar belirli bir satırdan sonra şişiyor ve kodlar çok yavaş ilerliyor. Yani makroyu koşturduğumda öncelikle hızlı hızlı işliyor sonrasında satır sayısının çok fazla olmasından makro çok yavaşlıyor ve saatleri alıyor.

Sizlerden son ricam, aşağıdaki değindiğim konuyu gerçekleştirmek mümkün müdür, yoksa çok mu hayalperestim :)

* Makro her 30.000 satırı excel de yeni bir sayfa açıp oraya aktaracak. (her 30000 satırda altındaki satır dolumu kontrol edecek, doluysa işleme devam edecek, dolu değilse yeni sayfa açıp veri aktarmayacak.)
Misal 280000 satırlı bir sayfada: 30000+30000+30000+30000+30000+30000+30000+10000 satırları 8 yeni sayfaya paylaştıracak.

* Yapılabilirse yani işlem satır sayısını 280.000 den, maximum 30.000 satıra düşürdük. Maximum 30.000 satır olan ve yeni açılan ilk sayfada vlookup la istenilen veriler dolacak. Veriler dolduktan sonra bu ilk 30.000 satır tekrardan 280.000 satırlı ana sayfada "ilk 30.000 e" yapıştırılacak. Sonrasinda ikinci 30.000 satır için açılan ikinci sayfa icin aynı işlemler yapılıp, 280.000 satırlı ana sayfada "ikinci 30.000 e" yapıştırılacak . Velasım son yeni açılan sayfada bitene kadar döngü devam edecek.

* Özetle ana sayfada 150000 satır varsa 5 yeni sayfada işlem yapılıp, işlem bittikten sonra açılan sayfalar silinecek.
Ana sayfada 50000 satır varsa 2 yeni sayfada işlem yapılıp, işlem bittikten sonra açılan yeni sayfalar silinecek. Vesaire...

--*--*--
Ekteki örnek.xlsm üzerinden yardımcı olabilir misiniz. Ekteki excel de;
- Anasayfa sayfasında gerçekte 280.000 küsür satır var ve bu sayı ileride artabilir.
- Anasayfa sayfasında "mevcut" değerler olup, "olması gereken" değerler kontrol sayfalarından vlookup lanacaklardır.

Teşekkürler :) Anlaşılamayan birşey olursa sizlerden dönüşe göre açıklamaya çalışacağım.
 

Ekli dosyalar

Merhaba.
Ne süzülecek?Konu nedir?
Kriterler nedir?
Çok fazla kriter sorgulanacaksa elbette işlem uzar.(Veritabanı çok büyükse)
 
Aslında bir kriter yok, sadece 8 tane mevcut değerim var ve bu 8 tane mevcut değerimin yanına 8 tane olması gereken değer yazdırılacak diğer sayfalardan.

Satır sayısı az olduğunda hızlıca yapıyor ama satır sayısı çok fazla ve belli bir satırdan sonra artık tek tük ilerliyor makro.

Üstteki post da ornek eki bulabilirsiniz. Asıl dosyayıda özel den yolladım size.(20MB) Bakabilirseniz sevinirim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst