veri süzerken mükerrer kayıtların toplanması

[tetrax]

formüllerle yapmaya çalıştım, ancak bir yerde ipin ucunu kaçırınca işin içinden çıkamadım bir türlü. çok hacimli verilere uygulayacağım için hücre hücre formül yazmaktansa makro ile daha efektif olabileceğini düşündüm...

değerli ustalarım yardımcı olabilirler mi acaba ?

örnek dosyam ekte...

 

[muhtar730]

bende bu konudan yardım bekliyorum.ama benim konu seçmeli veriyi istenen hüçrede bir arttırma şeklinde.yardımcı olacaklara şimdiden teşekkür ediyorum. dosyamı bir türlü ekleyemedim.

 

[Ali]

formüllerle yapmaya çalıştım, ancak bir yerde ipin ucunu kaçırınca işin içinden çıkamadım bir türlü. çok hacimli verilere uygulayacağım için hücre hücre formül yazmaktansa makro ile daha efektif olabileceğini düşündüm...

değerli ustalarım yardımcı olabilirler mi acaba ?

örnek dosyam ekte...

Özet Tablo ile daha ayrıntılı çözümler üretebilirsiniz.

Özet tablo ile yapılmış örnek ektedir.

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub AktarTopla()
On Error Resume Next
Dim a, i, n, b()
Set s1 = Sheets("data")
Set s2 = Sheets("rapor")
'*******************************************
a = s1.Range("a2:d" & s1.[a65536].End(3).Row).Value
ReDim b(1 To UBound(a, 1), 1 To 4)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
    z = a(i, 1) & ":" & a(i, 2)
          If Not IsEmpty(a(i, 1)) Then
                 If Not .exists(z) Then
                    n = n + 1
                    b(n, 1) = a(i, 1)
                    b(n, 2) = a(i, 2)
                    .Add z, n
                 End If
                    b(.Item(z), 3) = b(.Item(z), 3) + a(i, 3)
                    b(.Item(z), 4) = b(.Item(z), 4) + a(i, 4)
            End If
    Next
End With
'*******************************************
son = s2.[a65536].End(3).Row + 1
s2.Range(Cells(2, "a"), Cells(son, "d")).ClearContents
s2.[a2].Resize(n, 4).Value = b
'*******************************************
MsgBox "Bitti"
s2.Select
[a1].Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[tetrax]

sayın ripek çok teşekkür ederim.
tıkır tıkır işliyor....
tam istediğim gibi olmuş.
ellerin dert görmesin...

sayın ali hocam,
özet tablo çok şık görünüyor.
eğip büküp istediğin şekli de kolayca verebiliyorsun.
çok hoşuma gitti.
özet tablo olayına ayrı bir önem vermem gerekiyor...
çok sağol hocam, ufkumu genişlettiniz...

sayın muhtar730,
mesaj girdiğiniz bölümde aşağıya doğru sayfayı arayın,
üstünde "dosya ekle veya sil" yazan bir buton görmeniz lazım.
eğer daha önce bu butona tıklamışsanız,
büyük ihtimalle dosyanız çok büyük olduğundan gönderilmemiştir.
zipleyerek bir daha deneyin....