makro tam olarak çalışmıyor

[metinavci23]

merhaba arkadaşlar

ekteki dosyadan da görüleceği üzere "toplamlar" sayfasına "veriler" sayfasından verileri gün ve ürün olarak toplamaya çalıştım.ancak makro "k.95",k.97 ve lpg ürünün değerlerini hiç toplamıyor ve "kır" ve "mot" ürünün toplamlarını yanlış alıyor.makroyu sanki doğru yazdım ama ufak bir hatam var biryerde ve de bu hatayı bulamıyorum.yardımınızı bekliyorum

 

[dEdE]

Merhaba,
Eşitlik sınamasını yaptığınız,

If CDate(s1.Cells(i, "a")) = CDate(s2.Cells(k, "a")) And s1.Cells(i, "e").Value = s2.Cells(k, "b").Value Then

satırı çalıştığında s2.Cells(k, "a") değeri boş durumdadır. (Toplamlar sayfasındaki tarih ve şirket boş.) Bu durumda değerler hesaplanmadan geçilmekte ve sonra tarih ve şirket yazılmaktadır. Eğer aynı tarihte aynı şirket ikinci kez yazılmışsa 2. yazıımdan başlayarak toplamlar alınmaktadır. Aynı tarihte bir kez yazılan şirketler işlem dışı kalmakta diğerlerinin de ilk kaydı da toplama dahil edilmemektedir.

Çözüm: Tarih ve şirket adı eşitlik sınamasından önce yazılmalıdır.
Hoşçakalın.

 

[metinavci23]

Sayı Dede

Dediğiniz gibi yaptım yine olmadı.Dosyada düzenleme yapıp gönderme imkanınız var mı acaba.Teşekür ederim

 

[halit3]

bunu denermisiniz bu kodu buran almıştım size düzenledim

Sub AktarTopla()
Dim a, b, i, n, sat, veri()
Set s1 = Sheets("veriler")
Set s2 = Sheets("toplamlar")
'*******************************************
a = s1.Range("a2:k" & s1.[a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1), 1 To 10)
'*******************************************
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)

z = a(i, 1) & ":" & a(i, 5) ' & ":" & a(i, 5)

If Not IsEmpty(z) Then
If Not .exists(z) Then
n = n + 1
.Add z, n
veri(n, 1) = a(i, 1)
veri(n, 2) = a(i, 5)

End If
veri(.Item(z), 3) = veri(.Item(z), 3) + a(i, 7)
veri(.Item(z), 4) = veri(.Item(z), 4) + a(i, 9)
veri(.Item(z), 5) = veri(.Item(z), 5) + a(i, 10)
veri(.Item(z), 6) = veri(.Item(z), 6) + a(i, 11)

End If
Next i
End With
'*******************************************
sat = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(2, "a"), s2.Cells(sat, "f")).ClearContents
s2.[a2].Resize(n, 7).Value = veri
''*******************************************
s2.Select
MsgBox "Raporlama Tamamlandı", vbInformation, "Bilgi"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[metinavci23]

Teşekürler Sn.Halit3
Makro süper çalışıyor