• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

aynı tarih kriterine göre subtotal kullanımı

Katılım
26 Nisan 2005
Mesajlar
11
Merhaba,

a sütununda ki aynı tarihli kayıtları baz alarak b sütununda ki aynı numaralı kayıtların c sütununda ki bedellerine göre dip toplam almak mümkün müdür? Yardımcı olacak arkadaşlara şimdiden teşekkürler.

A sütunu hasar tarihi B sütunu dosya no C sütunu ödeme tutarı. aynı tarihte ki aynı dosya nolarına ait c sütununda bulunan değerlerin subtotu alınmalı ama nasıl. Farklı tarihlerde de aynı dosya nosu olabilir bu yüzden a sütun kontrolü önem arz ediyor.
 
Sevgili arkadaşlar bu konu ile ilgili bir önerisi olan var mı? Aynı değerlerin toplamı için subtot çok kullandığımız bir durum ama aynı tarihteki aynı değerlerin toplanması işlemi yapılamıyor. Yardımlarınız için şimdiden teşekkürler.
 
Havanda su dövmeyin!
Ekleyin bir tane örnek dosya .Üzerine bir miktar veri girin.Yapın dosya üzerinde açıklamsını.Bakın bakalım kaç kişi birden yardımcı olan çıkacaktır.:cool:
 
Haklısınız dosyayı ekledim. A sütununda sıralı olarak tarihler var ilk kriter bu aynı tarihte ki aynı dosya numalarının toplamını bulmak istiyorum.Liste orjinali yaklaşık 5000 satır.
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod:
Sub adet()
Dim z As Object, list(), sh As Worksheet, sat As Long, i As Long, myarr(), n As Long
Set sh = Sheets("Sheet2")
sat = 2
Sheets("Sheet1").Select
Application.ScreenUpdating = False
sh.Range("A2:C65536").ClearContents
Set z = CreateObject("Scripting.Dictionary")
list = Range("A2:C" & Cells(65536, "A").End(xlUp).Row).Value
ReDim myarr(1 To 3, 1 To UBound(list, 1))
For i = 1 To UBound(list, 1)
    If Not z.exists(list(i, 1) & list(i, 2)) Then
        n = n + 1
        z.Add list(i, 1) & list(i, 2), n
    End If
    myarr(1, z.Item(list(i, 1) & list(i, 2))) = list(i, 1)
    myarr(2, z.Item(list(i, 1) & list(i, 2))) = list(i, 2)
    myarr(3, z.Item(list(i, 1) & list(i, 2))) = myarr(3, z.Item(list(i, 1) & list(i, 2))) + list(i, 3)
Next
sh.Select
Range("A2").Resize(n, 3) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

İlginiz için çok teşekkürler yalnız, adet olarak değilde ödeme tutar toplamını almam gerekiyor. Yani 08.03.2005 tarihinde 3333333 nolu dosya için toplam 535,75 - 18.04.2005 teki 3333333 nolu dosya içinde 15 tl. gibi. Bu yapılabilirse sorun kalmayacak.
 
İlginiz için çok teşekkürler yalnız, adet olarak değilde ödeme tutar toplamını almam gerekiyor. Yani 08.03.2005 tarihinde 3333333 nolu dosya için toplam 535,75 - 18.04.2005 teki 3333333 nolu dosya içinde 15 tl. gibi. Bu yapılabilirse sorun kalmayacak.
Dosyayı istediğiniz şekilde güncelledim.
5 numaralı mesajdan inidrebilirsiniz.:cool:
 
Geri
Üst