Makro ile ÇokEtopla ( Application.WorksheetFunction.SumIfs )

[KarıncaZ]

Merhaba.

Aşağıdaki dosya için yardımlarınızı bekliyorum.
http://s5.dosya.tc/server5/arainw/Ornek_CokEtopla_Mkr.zip.html

Sub EToplaBorc()
Dim it As Date
Dim st As Date
Dim mHesap As Range
Dim mTarih As Range
Dim mBorc As Range
Dim hs As String

Set S1 = Sheets("Muavin")
Set S2 = Sheets("Hesapla")
son1 = S1.Range("A1000000").End(xlUp).Row
son2 = S2.Range("A1000000").End(xlUp).Row

't1 = CDate(S2.Cells(1, 3))
't2 = CDate(S2.Cells(1, 4))
it = S2.Cells(1, 3)
st = S2.Cells(1, 4)

Set mHesap = S1.Range("A3:A" & son1)
Set mTarih = S1.Range("F3:F" & son1)
Set mBorc = S1.Range("J3:J" & son1)

For i = 4 To son2
hs = S2.Cells(i, 1).Value
tplm = Application.WorksheetFunction.SumIfs(mBorc, mTarih, ">=" & it, mTarih, "<=" & st, mHesap, "=" & hs)
S2.Cells(i, 3) = tplm
Next i

End Sub

Kodlarını kullanıyorum. Birçok örneği inceledim sorun yok gibi ancak toplamları bir türlü doğru getirmiyor. Hep 0,00 olarak değer getiriyor.

Nerede hata yapıyorum bir türlü bulamadım.

Dosyada makro çalışınca olması gereken tutarlar da var.

Yardımlarınız için şimdiden teşekkürler. Esenlikler dilerim. iyi çalışmalar.

 

[Ziynettin]

Merhaba;

Verileriniz çok fazla kodu bu şekilde deneyiniz.

Option Explicit
Sub Etopla()
Dim Tarih_1 As Date, Tarih_2 As Date
Dim S1 As Worksheet, S2 As Worksheet
Dim a(), b(), c(), d As Object, Z As Date
Dim i As Long, Say As Long, Son1 As Long, Son2 As Long
Z = TimeValue(Now)
Application.ScreenUpdating = False
Set S1 = Sheets("Muavin")
Set S2 = Sheets("Hesapla")
Set d = CreateObject("Scripting.Dictionary")

Son1 = S1.Cells(Rows.Count, 1).End(xlUp).Row
a = S1.Range("A3:J" & Son1).Value
Tarih_1 = S2.[C1]
Tarih_2 = S2.[D1]

For i = 1 To UBound(a)
    If a(i, 6) >= Tarih_1 And a(i, 6) <= Tarih_2 Then
        d(a(i, 1)) = d(a(i, 1)) + a(i, 10)
    End If
Next i

Son2 = S2.Cells(Rows.Count, 1).End(xlUp).Row
b = S2.Range("A4:A" & Son2)

ReDim c(1 To UBound(b), 1 To 1)
For i = 1 To UBound(b)
c(i, 1) = d(b(i, 1))
Next i

S2.Range("C4:C" & Rows.Count).ClearContents
S2.[C4].Resize(UBound(b)) = c
Application.ScreenUpdating = True
MsgBox "işlem tamam..." & CDate(TimeValue(Now) - Z), vbInformation
End Sub

 

[KarıncaZ]

Merhaba sayın Ziynettin.

Hızlı bir şekilde verileri getirdi. Kodları genel anlamıyla kavradım ancak ilk defa rastladığım bazı ibareler var.

Dim a(), b(), c(), d As Object,
CreateObject("Scripting.Dictionary")
UBound ile de anladığım kadarıyla dizi oluşturmak için kullanıyoruz.

Rica etsem kodların mantığını biraz açıklar mısınız. Benim uğraştığım veriler en az 80.000 satırdan oluşuyor. İşlem yapmam gereken bir dosya da 990.000 satırdan fazla. Bu nedenle hızlı çalışacak makro kodlarını iyi öğrenmem gerekiyor. Formül yazınca çok kasıyor ve bazen hata ile karşılaşıyorum kaydetmiyor.

Yardımlarınız için şimdiden teşekkürler. Esenlikler dilerim. İyi çalışmalar.

.

 

[antonio]

Merhaba,
Sayın Ziynettin şu an bağlı değil. Sorduklarınıza ilişkin yardımcı olmaya çalışayım:
diziler VBA kodlarında çok kullanışlı işlevleri olan ve tercih edilen öğelerdir.
değişkenlerden parantez () içerenler dizilerdir. parantezin içine yazılan bir sayı varsa, dizinin belli bir sayıda elemanı olduğunu gösterir. a(5) şeklinde yazılan dizinin 6 elemanı vardır. Çünkü diziler 0 dan başlar
UBound, dizilerin en fazla kaç elemanı olduğunu verir. Tersi LBound dur.
Scripting.Dictionary, kelime veya rakam karşılaştırarak, bunlara eşşiz bir değer atayan bu özelliğiyle benzersiz veri hesaplamada çok kullanışlı ve hızlı sonuçlar veren bir scripting nesnesidir. VBA kodlarında birçok scripting nesnesi vardır. İleri düzey kodlama yapanlar bu nesnelerin değerini çok iyi bilirler ve her fırsatta bunları kullanırlar. Bu yüzeysel bilgileri bildikten sonra her biri için arama yaparken, "VBA makro diziler anlatım", "VBA makro Scripting Dictionary" şeklinde yazdığınızda çok değerli anlatımlara rastlayacaksınız.
Kolay gelsin.

 

[KarıncaZ]

Merhaba Sayın antonio

Vermiş olduğunuz bilgilerden dolayı çok teşekkür ederim.

Esenlikler dilerim. İyi çalışmalar.

 

[antonio]

Rica ederim. İyi çalışmalar.