• DİKKAT

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

Fazla veride kodlardaki yavaşlık

  • Konbuyu başlatan Konbuyu başlatan acar6783
  • Başlangıç tarihi Başlangıç tarihi
acar6783

acar6783

Katılım
6 Temmuz 2008
Mesajlar
1,875
Excel Vers. ve Dili
OFFİCE 2010- TÜRKÇE
arkadaşlar kolay gelsin yaptığım çalışmada sayfa 2 ,çin kullandığım bir kod mevcut fakat sayfadaki satır sayısı cok olduğunda kod çalışırken epey bir vakit alıyor.. bu konu ile ilgili değiştirmem gereken bir yer varmıdır yardımcı olursanız cok sevineceğim..
şimdiden teşekkürler..

kod:


Private Sub Worksheet_Activate()
Range("H2:J3000").Select
Selection.ClearContents
Set Sym = Sheets("Sayım1")

For i = 2 To Cells(65536, "E").End(xlUp).Row

For i2 = 2 To Sym.Cells(65536, "D").End(xlUp).Row

If Range("c" & i) = Sym.Range("a" & i2) Then Range("H" & i) = Sym.Range("b" & i2)
Range("ı" & i).Formula = "=RC[-2]-RC[-1]"
Range("j" & i).Value = "=IF(RC[-3]-RC[-2]=0,""TAM"",(IF(RC[-3]-RC[-1]=0,""GELMEDİ"",(IF(RC[-3]-RC[-1]<>0,(RC[-1]))))))"

Next i2
Next i

Columns("I:I").Select
Selection.Copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


End Sub
 
Merhaba,
Kod içinde formül kullanmak yerine yapmak istediğinizi doğrudan kod ile yaparsanız hem kodlar kısalacak hem de bir miktar hızlanacaktır.
Formül yerime kod kullanılması halinde selection-Copy-Paste sözcüklerinin kullanıldığı satırlara ve Application.CutCopyMode = False satırına da gerek kalmayacaktır. Zorunlu olmadıkça Select komutunu kullanmamalı. Örneğin, kodlarınızdaki
Kod: 
Range("H2:J3000").Select
Selection.ClearContents
satırı
Kod: 
Range("H2:J3000").ClearContents
şeklinde yazılabilir.

Eğer bu kod Sayım1 sayfası için yazılmışsa; (ki öyle görünüyor) Set komutunu da kullanmaya ve sayfa adı belirtmeye gerek yoktur.
Sonuçta her komut satırı tek tek işlem göreceği için gereksiz satırların da kodun çalışma süresini uzattığını unutmamak gerekir.
 
Son düzenleme:
Mümkünse dosyanızı ekleyebilirmisiniz. Üzerinden kontrol edelim.
 
Private Sub Worksheet_Activate()

Range("H2:J3000").ClearContents
Set Sym = Sheets("Sayım1")

For i = 2 To Cells(65536, "E").End(xlUp).Row

Range("ı" & i).Value = "=IF(RC[-2]-RC[-1]=0,""TAM"",(IF(RC[-1]=0,""GELMEDİ"",(IF(RC[-2]-RC[-1]<>0,(RC[-2]-RC[-1]))))))"

buradaki formul :=EĞER(G2-H2=0;"TAM";(EĞER(H2=0;"GELMEDİ";(EĞER(G2-H2<>0;(G2-H2))))))
acıklamaya gerek yok diye düşünüyorum

For i2 = 2 To Sym.Cells(65536, "D").End(xlUp).Row

If Range("E" & i) = Sym.Range("D" & i2) Then Range("H" & i) = Sym.Range("b" & i2)
(buradaki kodda e stünundaki veriyi sayım1 sayfasındaki d sütununda arayıp karşılık gelen b sütunudaki değeri getiriyor..)



Next i2
Next i
Columns("I:I").Copy
Columns("I:I").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub




kolay gesin ..
dediğiniz şekilde biraz gncelleme yaptım kendimce kısmen hızlandı fakat yine de bekliyor bir müddet makro çalışırken..
 
acar6783' Alıntı:
...dediğiniz şekilde biraz gncelleme yaptım kendimce kısmen hızlandı fakat yine de bekliyor bir müddet makro çalışırken..
Genişletmek için tıkla ...
Merhaba,
Birtakım değişiklikler yağmışsınız ama formüller hala duruyor. Önce sayfaya formülleri yazdırıyorsunuz, sonra da kopyala özel yapıştır ile formül sonucunu değere çeviriyorsunuz.
Bunun yerine formülün yaptığı işi doğrudan koda yaptırıp, doğrudan değeri yazdırmak işlem sayısını azaltacağından süreyi de kısaltacaktır.
Sayın ExcelF1 in dediği gibi örnek dosyanızı eklerseniz daha fazla yardımcı olabiliriz.
 
dosyam

sn dede hocam dosyamı ekledim
fakat ben formuluı koda cevirmeyi bilemiyorum hep araştırmalar sonucu bu kadar yapabildim. kod konusunda acıklamalı bir şekilde yardımcı olabilirmsiniz ben de anlayabilsem.
 
Merhaba,
Aşağıdaki kodu dener misiniz?
Kod: 
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Range("H2:J3000").ClearContents
Set sym = Sheets("Sayım1")
For i = 2 To Cells(65536, "E").End(xlUp).Row
    Set Aranan = sym.Range("D:D").Find(Range("E" & i).Value, , xlValues, xlWhole)
    If Not Aranan Is Nothing Then
    Range("H" & i) = sym.Range("b" & Aranan.Row).Value
    End If
    If Cells(i, "G").Value - Cells(i, "H").Value = 0 Then
        Cells(i, "I").Value = "TAM"
    ElseIf Cells(i, "H").Value = 0 Then Cells(i, "I").Value = "GELMEDİ"
    Else
        Cells(i, "I").Value = Cells(i, "G").Value - Cells(i, "H").Value
    End If
Next i
Application.ScreenUpdating = True
End Sub
 
Son düzenleme:
hocam cok teşekkür ederim çalışmanı için ..
fakat ürün listesi az olduğunda çalışıyor cok olduğunda run time error '13' type mismatch uyarısı veriyor..
 
Merhaba,
İlk yazdığınız kodda bulunan Range("H2:J3000").ClearContents ifadesine dayanarak 3500 satırlık verilerle denedim hata vermedi. (siz en fazla 3000 satır öngörmüşsünüz)Hatta bu ifadeye dayanarak, koddaki (For i = 2 To Cells(65536, "E").End(xlUp).Row) koyu işaretlediğim yere 3000 yazılarak bir miktar daha hızlanma sağlanabilir.
Type mismatch hatasının birçok nedeni olabilir. Hatalı dosyayı görmeden net birşey söylenemez. Ancak kod ile yaptığımız matematiksel işlemlerde(çıkarma işlemi) işleme karşılık gelen hücrelerde sayısal karakterlerin dışında bir karakter olması halinde ortaya çıkabilir.
Hata verdiğinde Debug yapılarak hatalı satırın hangisi olduğuna bakılarak varsa kod hatası araştırılabilir. Ayrıca i değişkenin aldığı değere karşılık gelen satır kontrol edilerek sayısal olmayan değer var mı diye bakılabilir.
 
hocam dediğinizi yaptım 3000 olarak değiştirdim fakat bu sefer de hiç bir işlem yapmadı..
 
acar6783' Alıntı:
hocam dediğinizi yaptım 3000 olarak değiştirdim fakat bu sefer de hiç bir işlem yapmadı..
Genişletmek için tıkla ...

Merhaba,
3000 ifadesi sadece milisaniye düzeyinde bir hızlanma sağlayabilir. 3000 yazmasanız da olur. Zaten milisaniye düzeyindeki hızlanmayı da fark edemezsiniz.
Sizin asıl sorununuz Type mismatch hatası idi. Onula ilgili yazdıklarımı dikkate alarak verilerinizi gözden geçirmekte yarar var.
En doğru sonuca gerçek ya da gerçeği birebir yansıtan örnek dosya üzerinden gidilebilir. Sonuçta yazdığımız kodlar örnek dosyaya göre. Asıl dosyanızda farklı veriler/veri tipleri varsa hata vermesi de normaldir. Örneğin sayısal veri olması gereken alanda string veri varsa işlem hata verir.
 
Dosya üzerinde gidelim

hocam dosyamı ekledim bunu üzerinden gidelim
 

Ekli dosyalar

Merhaba,
10. mesajda "...kod ile yaptığımız matematiksel işlemlerde(çıkarma işlemi) işleme karşılık gelen hücrelerde sayısal karakterlerin dışında bir karakter olması halinde ortaya çıkabilir.
Hata verdiğinde Debug yapılarak hatalı satırın hangisi olduğuna bakılarak varsa kod hatası araştırılabilir. Ayrıca i değişkenin aldığı değere karşılık gelen satır kontrol edilerek sayısal olmayan değer var mı diye bakılabilir."
12. mesajda da "... sayısal veri olması gereken alanda string veri varsa işlem hata verir." diye yazmıştım.

Dosyanızı açtım. Hata verince Debug tuşuna tıkladım. If Cells(i, "G").Value - Cells(i, "H").Value = 0 Then satırı hatalı görünüyordu. Bu satır G sütunundaki değerden H sütunundaki değeri çıkarıp sonucun sıfır olup olmadığına bakıyor. Mous işaretcisini hatalı satırdaki i değişkeninin üzerine götürdüğümde bana i=3498 ifadesini gösterdi. 3498. satırın G sütununda (boş) yazıyor. Yani string değer var. Sorun şu; G sütunundaki (boş) kelimesinden H sütunundaki sıfır değerini çıkaramadığımıza göre hata oluşacaktır. Bu hata görmezden gelinebilir(On Error Resume Next) ama aynı anda başka olası hatalar da gözardı edileceğinden önermiyorum.
Çözüm: Matematiksel işlem yapılan sütunlarda (G ve H) sayısal ifadelerin dışında karakterler bulunmamalı.
Özet:G3498 hücresindeki (boş) ifadesini silmelisiniz.
Not:Bu kadar uzun yazmamın nedeni balık ikram etmek yerine balık tutmayı öğrenmenize yardımcı olmaktı.
Hoşçakalın.
 
hocam acıklamalı bilghileriniz için cok teşekkür ederim sayenizde cok şey öğrendim..

boş yazan hücrelerin sebebi özet tablo verisi kullandığımdan oluyor...boş yazan satırı haliyle silemiyorum ..orada neden boş yazdığını da bilmiyorum acaba tabloda boş yazan yerlere başka bir sayısal değer yazdırmamızın ya da silmemizin baçka bir yolu varmıdır..
 
Kod: 
Private Sub CommandButton5_Click()
[COLOR="red"]Application.Calculation = xlCalculationManual[/COLOR] 'Otomatik Hesaplamayı manuel yap
[COLOR="Red"]Application.ScreenUpdating = False[/COLOR] 'Ekran Gücenllemesi İptali

kodlar......


[COLOR="red"]Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic[/COLOR]

end sub

kod hızlandırmak içindir
 
Son düzenleme:
Merhaba,
Aşağıdaki şekilde dener misiniz?
Kod: 
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Range("H2:I65536").ClearContents
Set sym = Sheets("Sayım1")
For i = 2 To Cells(65536, "A").End(xlUp).Row
    Set Aranan = sym.Range("A:A").Find(Range("C" & i).Value, , xlValues, xlWhole)
    If Not Aranan Is Nothing Then Range("H" & i) = sym.Range("b" & Aranan.Row).Value
    If Cells(i, "G").Value = "(boş)" Then GoTo Atla
    If Cells(i, "G").Value - Cells(i, "H").Value = 0 Then
        Cells(i, "I").Value = "TAM"
    ElseIf Cells(i, "H").Value = 0 Then Cells(i, "I").Value = "GELMEDİ"
    Else
        Cells(i, "I").Value = Cells(i, "G").Value - Cells(i, "H").Value
    End If
Atla:
Next i
Application.ScreenUpdating = True
End Sub
 
teşekkür ederim hocam Allah razı olsun..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst