makro kodu çok yavaş çalışıyor.

[finike]

arkadaslar aşşağıda yazmış olduğum formulü makro kodu ile çalıştırıyorum fakat çok yavaş çalışıyor. (çok bekletiyor)
kodu hızlandırmak için yardımcı olursanız sevinirim. Saygılar.

Sub TOTAL()
'=(İNDİS(TOTALLER!C$2:TOTALLER!C$15000;TOPLA.ÇARPIM((KAÇINCI($AC$3&"@"&$AD3;TOTALLER!$A$2:TOTALLER!$A$15000&"@"&TOTALLER!$B$2:TOTALLER!$B$15000;0))))-İNDİS(TOTALLER!C$2:TOTALLER!C$15000;TOPLA.ÇARPIM((KAÇINCI($AC$4&"@"&$AD3;TOTALLER!$A$2:TOTALLER!$A$15000&"@"&TOTALLER!$B$2:TOTALLER!$B$15000;0)))))/(10)
Range("AE3").Select
ActiveCell.FormulaR1C1 = _
"=(INDEX(TOTALLER!R2C[-28]:TOTALLER!R15000C[-28],SUMPRODUCT((MATCH(R3C29&""@""&RC30,TOTALLER!R2C1:TOTALLER!R15000C1&""@""&TOTALLER!R2C2:TOTALLER!R15000C2,0))))-INDEX(TOTALLER!R2C[-28]:TOTALLER!R15000C[-28],SUMPRODUCT((MATCH(R4C29&""@""&RC30,TOTALLER!R2C1:TOTALLER!R15000C1&""@""&TOTALLER!R2C2:TOTALLER!R15000C2,0)))))/(10)"

Selection.Copy
Range("AE3:AF12").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AE3").Select
Application.CutCopyMode = False
Range("AF11:AF12").Select
Selection.ClearContents

End Sub
Sub vardiya()
'=İNDİS(VARDİYA!D$2:VARDİYA!D$15000;TOPLA.ÇARPIM((KAÇINCI($AC$3&"@"&$AG3;VARDİYA!$A$2:VARDİYA!$A$15000&"@"&VARDİYA!$B$2:VARDİYA!$B$15000;0))))/1000
Range("AH3").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(VARDİYA!R2C[-30]:VARDİYA!R15000C[-30],SUMPRODUCT((MATCH(R3C29&""@""&RC33,VARDİYA!R2C1:VARDİYA!R15000C1&""@""&VARDİYA!R2C2:VARDİYA!R15000C2,0))))/1000"

'=İNDİS(VARDİYA!E$2:VARDİYA!E$15000;TOPLA.ÇARPIM((KAÇINCI($AC$3&"@"&$AG3;VARDİYA!$A$2:VARDİYA!$A$15000&"@"&VARDİYA!$B$2:VARDİYA!$B$15000;0))))/100
Range("AI3").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(VARDİYA!R2C[-30]:VARDİYA!R15000C[-30],SUMPRODUCT((MATCH(R3C29&""@""&RC33,VARDİYA!R2C1:VARDİYA!R15000C1&""@""&VARDİYA!R2C2:VARDİYA!R15000C2,0))))/100"

Range("ah3:AI3").Select
Selection.Copy
Range("Ah3:AI10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AE3").Select


End Sub

benim istediğim makro ile butona basınca;
=(İNDİS(TOTALLER!C$2:TOTALLER!C$15000;TOPLA.ÇARPIM((KAÇINCI($AC$3&"@"&$AD3;TOTALLER!$A$2:TOTALLER!$A$15000&"@"&TOTALLER!$B$2:TOTALLER!$B$15000;0))))-İNDİS(TOTALLER!C$2:TOTALLER!C$15000;TOPLA.ÇARPIM((KAÇINCI($AC$4&"@"&$AD3;TOTALLER!$A$2:TOTALLER!$A$15000&"@"&TOTALLER!$B$2:TOTALLER!$B$15000;0)))))/(10)
formülü AE3:AF12 hücrelerine çalıştırmak.

ilgili dosya ektedir.

 

[Levent Menteşoğlu]

Yazdığınız kodu yavaş çalışmasının sebebi formül içinde TOPLA.ÇARPIM fonksiyonunu kullanmanızdır. Bu fonksiyon veri sayısı çoğaldıkça yavaş çalışmaya başlar bu sebeple işlem geç yapılmaktadır. Bunun yerine ben size çok hızlı çalışan bir ADO kodu önereceğim. Farklı ADO kodlarıda öneren üyelerimiz olursa bende memnun olurum.

Sub TOTAL()
On Error Resume Next
Set baglanti = CreateObject("ADODB.Connection")
yol = "Driver={microsoft excel driver (*.xls)};dbq=" & ThisWorkbook.FullName
baglanti.Open yol
For a = 3 To [ad65536].End(3).Row
aranan1 = "SELECT * FROM `TOTALLER$a1:g65536` WHERE `SHIFTNAME`='" & [AC3] & "'" & " and `CPUNO`='" & Cells(a, "ad") & "'"
aranan2 = "SELECT * FROM `TOTALLER$a1:g65536` WHERE `SHIFTNAME`='" & [AC4] & "'" & " and `CPUNO`='" & Cells(a, "ad") & "'"
Set rs1 = baglanti.Execute(aranan1)
Set rs2 = baglanti.Execute(aranan2)
Cells(a, "ae") = (rs1.fields(2) - rs2(2)) / 10
Cells(a, "af") = (rs1.fields(3) - rs2(3)) / 10
Next
rs1.Close
rs2.Close
baglanti.Close
End Sub

 

[finike]

Levent bey uyguladım gerçekten çok hızlı çalıştı. ilginize çok teşekkür ederim.
mümkünse; Sub vardiya() makrosunuda bu şekilde uyarlayabilirmisiniz.
saygılar.

 

[Levent Menteşoğlu]

Vardiya içinde aşağıdaki kodu deneyin.

Sub vardiya()
On Error Resume Next
Set baglanti = CreateObject("ADODB.Connection")
yol = "Driver={microsoft excel driver (*.xls)};dbq=" & ThisWorkbook.FullName
baglanti.Open yol
For a = 3 To [ad65536].End(3).Row
aranan = "SELECT * FROM `vardiya$a1:e65536` WHERE `SHIFTNAME`='" & [AC3] & "'" & " and `FUELTYPE`=" & Cells(a, "ad")
Set rs1 = baglanti.Execute(aranan)
Cells(a, "ah") = rs1.fields(3) / 1000
Cells(a, "aI") = rs1.fields(4) / 100
Next
rs1.Close
baglanti.Close
End Sub

 

[finike]

Levent bey uyguladım gerçekten çok hızlı çalıştı. ilginize çok teşekkür ederim. Saygılar.

 

[hsayar]

levent hocam adodb örnmekleri için bir kaynak önerebilirmisiniz...

Aranan = "SELECT * FROM `vardiya$a1:e65536` WHERE `SHIFTNAME`='" & [AC3] & "'" & " and `FUELTYPE`=" & Cells(a, "ad")

yeni gördüğüm bir sorgu yöntemi işlevi tam olarak nedir.

 

[Levent Menteşoğlu]

Kaynak konusunda forumumuzdaki örnekleri inceleyebileceğiniz gibi yerli veya yabancı bir çok forumda gerekli bilgilere ulaşabilirsiniz. Bu türde sorgulama çok sık kullanılan bir yöntemdir.

ADO konusunda bir amatör olarak yukarıda verdiğiniz satırı kısaca ifade etmeye çalışayım. Bu yazım şeklinde vardiya sayfasındaki a1:e65536 aralığında SHIFTNAME ve FUELTYPE başlıklarını içeren sütunlarda her iki kriterede uyan verileri sorgular.

 

[hsayar]

teşekkür ederim hocam.. wheredan sonra shiftname görünce başak bir çalışmasayfaına referans gönderdiniz sandıım...

 

[Zeki Gürsoy]

levent hocam adodb örnmekleri için bir kaynak önerebilirmisiniz...

Aranan = "SELECT * FROM `vardiya$a1:e65536` WHERE `SHIFTNAME`='" & [AC3] & "'" & " and `FUELTYPE`=" & Cells(a, "ad")

yeni gördüğüm bir sorgu yöntemi işlevi tam olarak nedir.

Structure Query Language

Microsoft Jet SQL yapısını öğrenmek için aşağıdaki başlıkta bulunan dökümanları inceleyebilirisiniz.

http://www.excel.web.tr/f66/sql-basvuru-kitapl-g-t57933.html

 

[hsayar]

Zeki hocam teşekkür ederim.