Soru İki tarih arası koşullu toplama

[TUNCA ERSİN]

Sy. Hocalarım ;
ekli dosyada açıklama yaptım. HESAP FİŞİ , iş, dönüş sayfalarından veriler var KOM sayfasında raporlanacaktır. yardımlarınız için teşekkür ederim.

 

[ÖmerFaruk]

Aşağıdaki kodları Module içine kopyalayıp, KOM sayfasında çalıştırabilirsin.
Denedim ve sonuç gayet hızlı ve doğru.

Edit: Açıklamalar eklendi.

Sub YeniHesaplamaFormülsüz()
   'Değişkenleri tanımlıyoruz
   Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
   Set Sh = Worksheets("HESAP FİŞİ")
   'Mevcut sayflarınızdaki verileri Dizilere alıyoruz
   'Sadece excelin işlemleri daha hızlı yapması için
   'Worksheets("HESAP FİŞİ").Range("A2").End(xlDown).Row
   'Bu mesela Hesap Fişi sayfasındaki A2 nin altında bulunan son dolu hücreyi(boş hücreden önceki) bulur.
   Arr1 = Worksheets("HESAP FİŞİ").Range("A2:V" & Worksheets("HESAP FİŞİ").Range("A2").End(xlDown).Row).Value
   Arr2 = Worksheets("iş").Range("A2:R" & Worksheets("iş").Range("A2").End(xlDown).Row).Value
   Arr3 = Worksheets("dönüş").Range("A2:P" & Worksheets("dönüş").Range("A2").End(xlDown).Row).Value
   If ActiveSheet.Name <> "KOM" Then Exit Sub               'KOM sayfasında değilseniz KOD çalışmasın diye yaptım. Başka yöntemler de yapılabilirdi. Bunu tercih ettim.
   Arr = Range("A3:A" & Range("A3").End(xlDown).Row).Value  'KOM sayfasındaki verileri de diziye aldım
   ReDim Liste(1 To UBound(Arr), 1 To 9)                    'Verilerin satır sayısı kadar yükseklikte ve 9 sütun genişliğinde yeni bir LİSTE tanımladım
   For i = LBound(Arr) To UBound(Arr)
      ReDim Toplam(1 To 8)                                  'Toplamları hızlı yazabilmek için onlarıda tek boyutlu bir diziye tanımladım
      For k = 1 To UBound(Arr1)
         If Int(CDbl(Arr1(k, 2))) = CDbl(Arr(i, 1)) Then    'Arr1 dizindeki (hesap Fişi) Tarih+Saat formatındaki veriden sadece Tarih kısmını alarak Arr (KOM daki veriler) dizindeki tarihle karşılaştırdım
            Select Case Arr1(k, 4)                          'Eğer tarihler aynı ise Arr1 in 4.sütununa baktım
               Case Range("C1")                             'C1 le aynı ise C1 için değerleri topladım
                  Toplam(1) = Toplam(1) + Arr1(k, 10)
                  Toplam(2) = Toplam(2) + Arr1(k, 14)
               Case Range("H1")                             'H1 ile aynı ise H1 için değerleri topladım
                  Toplam(6) = Toplam(6) + Arr1(k, 6)
               Case Range("I1")                             'I1 ile aynı ise....
                  Toplam(7) = Toplam(7) + 1
            End Select
            Toplam(4) = Toplam(4) + Arr1(k, 13)             'Bunlar da diğer toplamını bulmak istediğimiz değerler
            Toplam(5) = Toplam(5) + Arr1(k, 8)
         End If
      Next k
      For k = 1 To UBound(Arr2)                             'Yukarıdakine benzer olarak Arr2 verileri(iş sayfasındaki) kullanarak ilgili toplamları buldum
         If Int(CDbl(Arr2(k, 3))) = CDbl(Arr(i, 1)) Then    'Burda da aynı tarihe sahipseler 9.sütundaki değerlerin toplamını alıyoruz. Benzer basit işlemler.
            Toplam(3) = Toplam(3) + Arr2(k, 9)
         End If
      Next k
      For k = 1 To UBound(Arr3)                             'burda da dönüş sayfasındaki veriler için benzer bir işlem yapıyoruz.
         If Int(CDbl(Arr3(k, 2))) = CDbl(Arr(i, 1)) Then
            Toplam(8) = Toplam(8) + Arr3(k, 11)
         End If
      Next k
      For k = 1 To 8                                        'Toplamları listemizin sütunlarına yazıyoruz. En dıştaki For-Next döngüsüyle de tüm satırlara aynı işlemi tekrarlıyoruz
         Liste(i, k + 1) = Toplam(k)
         Liste(i, 1) = Liste(i, 1) + Toplam(k)
      Next k
   Next i
   Range("B3").Resize(UBound(Liste), 9) = Liste             'KOM sayfamızdaki B3 den başlayıp Listemizinm satır sayısı kadar yükseklikteki ve 9 sütun genişliğinde bir aralığa LİSTE isimli listemize kaydettiğimiz verileri kopyalıyoruz.
End Sub

 

[TUNCA ERSİN]

Sy. @ÖmerFaruk ;
Hocam elinize sağlık çok güzel olmuş. Diğer sayfalara ve diğer hücrelere de uygulama yapmam için. Kodların hangisinin ne anlama geldiğini yanlarına yaza bilir misiniz.

örnek :
ReDim Liste(1 To UBound(Arr), 1 To 9) ' Bu sonucun yazılacağı hücre aralığını belirler
ReDim Toplam(1 To 8) ' Bu hangi hücreye sonucun gelmesini belirler
vb.

size zahmet olmazsa yardımcı olur musunuz. Teşekkür ederim. İyi günler dilerim.

 

[ÖmerFaruk]

Kodların açıklamalarını önceki mesaja ekledim.

 

[TUNCA ERSİN]

sy. @ÖmerFaruk ;
Allah razı olsun hocam çok teşekkür ederim.