Soru VBA Kod ile bir sayfadan veri alırken toplamlarda hata

[Erkan Yılmaz]

Merhaba Üstadlarım,

Ek'te gönderiş olduğum dosyada Satış İcmal sayfam bulunmaktadır. Aşağıda ki göndereceğim vba kodlarda 4 senaryoda c2 ve d2 tarih aralığına göre verileri getirmekteyim.

Ana Grup adlarına, Ara Grup adlarına, Alt Grup adlarına ve Ürün adlarına göre tarih aralıklarında ki verilerin toplamlarını getiriyorum . Ama şu anda doğru veriyi sadece Ana Grup adlarında alabiliyorum .

Diğer gruplarda sanırım tarih filtrelemesi yapmıyor nerede yanlışlık yapmış olabilirim.

1 nolu ekran görüntüsünde toplam tutarlara bakacak olursak sadece Ana grup adları toplamları doğru bununda sağlamasını zaten Satış İcmal Formüllü sayfasından yapabiliyorum formül çok olunca ağır çalışıyor bu yüzden VBA koda başvurdum.


1 nolu ekran görüntüsü.png - 186 KB


02-2025 Ekstra Satış Raporlar.xlsm - 607 KB


Konuyla ilgili yardımcı olursanız sevinirim.



Sub SatisIcmalHesapla()
Dim wsData As Worksheet, wsIcmal As Worksheet
Dim dataArr As Variant
Dim startDate As Date, endDate As Date
Dim primKontrol As Boolean

' Sayfaları ata
Set wsData = ThisWorkbook.Sheets("SatışData (2)")
Set wsIcmal = ThisWorkbook.Sheets("Satış İcmal")

' Tarihleri al
If IsDate(wsIcmal.Range("C2").value) And IsDate(wsIcmal.Range("D2").value) Then
startDate = wsIcmal.Range("C2").value
endDate = wsIcmal.Range("D2").value
Else
MsgBox "Geçerli bir tarih aralığı giriniz.", vbExclamation
Exit Sub
End If

' Prim kontrol: I3 hücresi TRUE/FALSE
primKontrol = (wsIcmal.Range("I3").value = True)

' Verileri al
dataArr = wsData.Range("A1").CurrentRegion.value ' Tüm tablo

' Ana Grup (N sütunu), Satır başlangıcı: 6
Call SenaryoIsle(dataArr, wsIcmal, "N", 6, startDate, endDate, primKontrol)

' Ara Grup (O sütunu), Satır başlangıcı: 14
Call SenaryoIsle(dataArr, wsIcmal, "O", 14, startDate, endDate, primKontrol)

' Alt Grup (P sütunu), Satır başlangıcı: 30
Call SenaryoIsle(dataArr, wsIcmal, "P", 30, startDate, endDate, primKontrol)

' Ürün Adı (L sütunu), Satır başlangıcı: 70
Call SenaryoIsle(dataArr, wsIcmal, "L", 70, startDate, endDate, primKontrol)

MsgBox "Özet başarıyla oluşturuldu.", vbInformation
End Sub

Sub SenaryoIsle(dataArr As Variant, wsIcmal As Worksheet, grupColLetter As String, _
startRow As Long, startDate As Date, endDate As Date, primKontrol As Boolean)

Dim i As Long, j As Long, rowCount As Long
Dim grupDict As Object
Set grupDict = CreateObject("Scripting.Dictionary")

' Sütun indekslerini bul
Dim colMap As Object: Set colMap = CreateObject("Scripting.Dictionary")
colMap("Tarih") = 3 ' C sütunu
colMap("Grup") = ColumnLetterToNumber(grupColLetter)
colMap("Miktar") = ColumnLetterToNumber("U")
colMap("EuroKDVDahil") = ColumnLetterToNumber("X")
colMap("EuroKDVHaric") = ColumnLetterToNumber("Z")
colMap("TLKDVDahil") = ColumnLetterToNumber("AD")
colMap("TLKDVHaric") = ColumnLetterToNumber("AF")
colMap("KDV") = ColumnLetterToNumber("AE")
colMap("Prim") = ColumnLetterToNumber("AG")
colMap("Maliyet") = ColumnLetterToNumber("AR")

rowCount = UBound(dataArr, 1)

' Gruplara göre verileri topla
For i = 2 To rowCount
Dim tarihVal As Variant: tarihVal = dataArr(i, colMap("Tarih"))
If IsDate(tarihVal) Then
If tarihVal >= startDate And tarihVal <= endDate Then
Dim grupAdi As String: grupAdi = Trim(dataArr(i, colMap("Grup")))
If Len(grupAdi) > 0 Then
If Not grupDict.exists(grupAdi) Then
grupDict.Add grupAdi, Array(0, 0, 0, 0, 0, 0, 0, 0)
End If
Dim totals As Variant: totals = grupDict(grupAdi)
totals(0) = totals(0) + Nz(dataArr(i, colMap("Miktar")))
totals(1) = totals(1) + Nz(dataArr(i, colMap("EuroKDVDahil")))
totals(2) = totals(2) + Nz(dataArr(i, colMap("EuroKDVHaric")))
totals(3) = totals(3) + Nz(dataArr(i, colMap("TLKDVDahil")))
totals(4) = totals(4) + Nz(dataArr(i, colMap("TLKDVHaric")))
totals(5) = totals(5) + Nz(dataArr(i, colMap("KDV")))

' ? Prim sadece I3 TRUE ise ve A sütunu da TRUE ise toplanır
If primKontrol Then
If dataArr(i, 1) = True Then ' A sütunu
totals(6) = totals(6) + Nz(dataArr(i, colMap("Prim")))
End If
End If

totals(7) = totals(7) + Nz(dataArr(i, colMap("Maliyet")))
grupDict(grupAdi) = totals
End If
End If
End If
Next i

' Sonuçları yazdır
Dim rowIndex As Long: rowIndex = startRow
Dim key As Variant
For Each key In grupDict.Keys
wsIcmal.Cells(rowIndex, "B").value = key
Dim values As Variant: values = grupDict(key)
For j = 0 To 7
wsIcmal.Cells(rowIndex, 3 + j).value = values(j) ' C-J sütunları
Next j
rowIndex = rowIndex + 1
Next key
End Sub

Function ColumnLetterToNumber(colLetter As String) As Long
ColumnLetterToNumber = Range(colLetter & "1").Column
End Function

Function Nz(value As Variant) As Double
If IsNumeric(value) Then
Nz = CDbl(value)
Else
Nz = 0
End If
End Function