Makro hızlandırma

[almrtlr]

Arkadaşlar herkese selamalr,
Sayın Yurttaşın altta yazan makrosunu kullanıyorum ancak çok ağır hesaplıyor
sanki Bu makroyu daha hızlı çalıştırabilirmiyiz acaba?

Public Function TOPLATL( _
ParamArray vInput() As Variant) As Variant
Dim rParam As Variant
Dim rCell As Range
Dim vTemp As Variant

Application.Volatile
On Error GoTo Hata
For Each rParam In vInput
If TypeName(rParam) = "Range" Then
With rParam
For Each rCell In Intersect( _
.Cells, .Cells.Parent.UsedRange)
With rCell
If .NumberFormat = "#,##0.00 $" Then
If IsError(.Value) Then
vTemp = .Value
Exit For
ElseIf VarType(.Value2) = vbDouble Then
vTemp = vTemp + .Value2
End If
End If
End With
Next rCell
End With
End If
Next rParam
TOPLATL = vTemp
Devam:
On Error GoTo 0
Exit Function
Hata:
If Err.Number = 6 Then TOPLATL = CVErr(xlErrNum)
Resume Devam
End Function

Public Function TOPLAUSD( _
ParamArray vInput() As Variant) As Variant
Dim rParam As Variant
Dim rCell As Range
Dim vTemp As Variant

Application.Volatile
On Error GoTo Hata
For Each rParam In vInput
If TypeName(rParam) = "Range" Then
With rParam
For Each rCell In Intersect( _
.Cells, .Cells.Parent.UsedRange)
With rCell
If .NumberFormat = "[$$-409]#,##0.00" Then
If IsError(.Value) Then
vTemp = .Value
Exit For
ElseIf VarType(.Value2) = vbDouble Then
vTemp = vTemp + .Value2
End If
End If
End With
Next rCell
End With
End If
Next rParam
TOPLAUSD = vTemp
Devam:
On Error GoTo 0
Exit Function
Hata:
If Err.Number = 6 Then TOPLAUSD = CVErr(xlErrNum)
Resume Devam
End Function

Public Function TOPLAmanat( _
ParamArray vInput() As Variant) As Variant
Dim rParam As Variant
Dim rCell As Range
Dim vTemp As Variant

Application.Volatile
On Error GoTo Hata
For Each rParam In vInput
If TypeName(rParam) = "Range" Then
With rParam
For Each rCell In Intersect( _
.Cells, .Cells.Parent.UsedRange)
With rCell
If .NumberFormat = "#,##0.00 [$MNT]" Then
If IsError(.Value) Then
vTemp = .Value
Exit For
ElseIf VarType(.Value2) = vbDouble Then
vTemp = vTemp + .Value2
End If
End If
End With
Next rCell
End With
End If
Next rParam
TOPLAmanat = vTemp
Devam:
On Error GoTo 0
Exit Function
Hata:
If Err.Number = 6 Then TOPLAmanat = CVErr(xlErrNum)
Resume Devam
End Function

 

[Ergün Güler]

selam,
Kodların aktif olduğu sayfada fonksiyonlar kullanıyor musunuz?

 

[almrtlr]

Evet oldukça fazla kullanıyorum ama kodu eklemeden önce hiç bir şekilde bu kadar yavaş çalışmıyordu,kodu ekleyince aşırı yavaşladı.

 

[Ergün Güler]

Evet oldukça fazla kullanıyorum ama kodu eklemeden önce hiç bir şekilde bu kadar yavaş çalışmıyordu,kodu ekleyince aşırı yavaşladı.

Selam,
Yavaşlamanın sebebi verdiğiniz koldar ile tek başına anlaşılamaz. Ben, hem makro hem de fonksiyon olarak kullandığım sayfalarda şu şekilde yapıyorum

Sub örnek()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'
'
'
'Bu bölümde kodlarım
'
'
'
'
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Oldukça hızlanıyor. Örneğin bir sayfam vardı. Bu kodlardan önce 5-10 dk hesaplar iken şimdi 1-2 sn.de hesaplıyor.
Muhtemelen siz Public Function'ları başka kodlar içinde kullanıyorsunuz. İşte bu kullandığınız kodların başına ve sonuna yukarıdaki kodları ekleyerek bir deneyiniz.

 

[almrtlr]

Sn Ergün Güler öncelikle ilginize teşekkür ediyorum.
Makro konusundo çok fazla bilgim yok bu nedenle demek istediğinizi anlayamadım.
Ben Sn Yurttaşın örnek verdiği makro kodunu kendi sayfama yapıştırdım sadece
işimi görüyor ama çok yavaş çalışıyor,eğer dediğinizi uygulayabilirsem süper olur
ama nasıl?
Cevabınızı bekliyorum
Saygılar...

 

[almrtlr]

Yardım edebilecek arkadaşlardan cevap bekliyorum.

Saygılar...

 

[Merhum İdris SERDAR]

.

http://www.excel.web.tr/f122/farkly-para-cinslerinin-toplanmasy-yontemleri-t87186.html

Buraya eklediğim dosyada yer alan:

Function TOPLATL(alan As Range)

Application.Volatile

For Each Cell In alan
If Cell.NumberFormat = "#,##0.00 $" Then
TOPLA = TOPLA + Cell.Value
End If
Next Cell

TOPLATL = TOPLA
End Function


Function TOPLAD(alan As Range)

Application.Volatile

For Each Cell In alan
If Cell.NumberFormat = "[$$-409]#,##0.00" Then
TOPLA = TOPLA + Cell.Value
End If
Next Cell

TOPLAD = TOPLA
End Function


Function TOPLAE(alan As Range)

Application.Volatile

For Each Cell In alan
If Cell.NumberFormat = "[$€-2] #,##0.00" Then
TOPLA = TOPLA + Cell.Value
End If
Next Cell

TOPLAE = TOPLA
End Function

Function TOPLAP(alan As Range)

Application.Volatile

For Each Cell In alan
If Cell.NumberFormat = "[$£-809]#,##0.00" Then
TOPLA = TOPLA + Cell.Value
End If
Next Cell

TOPLAP = TOPLA
End Function

kodları kendi dosyanıza uyarlayın.


.

 

[almrtlr]

Sn. Yurttaş bütün formulleri götürüyor bu makro (DEĞER Hatası veriyor)
buna rağmen hızında en ufak bir değişiklik olmadı,hatta dahada ağırlaştı gibi.

 

[almrtlr]

Sn. Yurttaş sizin yazdığınız ilk makro (1. mesajımdaki) acaba daha hızlı çalışır hale getirilemez mi?

 

[Ergün Güler]

Sn. Yurttaş bütün formulleri götürüyor bu makro (DEĞER Hatası veriyor)
buna rağmen hızında en ufak bir değişiklik olmadı,hatta dahada ağırlaştı gibi.

Sayın almrtlr,
Sayın Yurttaş'ın verdiği kodları denedim. herhangi bir sıkıntı yok.
anladığım kadarıyla siz de zaten =TOPLATL gibi fonksiyon mevcut. eski kodları silip yenisini ekleyince (Sayın Yurttaş'ın), hücrelerdeki TOPLATL formüllerini aşağıdaki gibi girerek deneyiniz. E5:E16 aralığı örnektir.

=TOPLATL(E5:E16)

[/CODE]

 

[almrtlr]

Sn Ergün Güler
Dediklerinizi uyguladım ama DEĞER hatası veriyor,sadece TL de değil
diğer para birimlerindede aynı hatayı veriyor,sistem çöküyor yani,
bana ilk örnekteki kodları hızlandıracak bir makro gerekli sanırım...

 

[Ergün Güler]

Sn Ergün Güler
Dediklerinizi uyguladım ama DEĞER hatası veriyor,sadece TL de değil
diğer para birimlerindede aynı hatayı veriyor,sistem çöküyor yani,
bana ilk örnekteki kodları hızlandıracak bir makro gerekli sanırım...

Selam,
Dosyanızdaki kodları hızlandırabilmek için, önce sorunlu dosyanızı konuya eklemek içib hızlı olmanız gerekirdi.
dosyanızı eklememekte ısrar ediyorsunuz.