[ÇÖZÜLDÜ] Farklı Tarihleri Toplam alma

[ANTALYA 01]

Merhabalar

Ekteki çalışmada Şöyle bir makroya ihtiyacım var.C sütununda Tarih var D sütununda Girişler E Sütununda Çıkışlar Fakat Giriş ve Çıkışların Tarihleri aynı olmasına rağmen farklı satırlardalar bu farklı olan satırlardaki Tarihlerin Giriş çıkışlarının Toplanmasını ve farklı satırlarda mevcut olan giri çıkışların silinmesini istiyorum.Manuel makro kaydetle yapmak istediğimi anlatmaya çalıştım.
Örnek olarak ;
C sütununun 12.satırında 06.10.2008 tarihinde D sütununda 10 Giriş var makro bu 10 girişi burdan silecek sıfır olacak bu hücre C sütununun 5 Satırındaki 06.10.2008 Tarihi aynı olduğu için D sütunundaki 5 satırda mevcut olan 2340 rakamına 10 ekleyecek sonuç =2340+10=2350 olacak d5 Hücresi

Sub Makro1()
'
' Makro1 Makro
' Makro pc tarafından 19.10.2008 tarihinde kaydedildi.
'

'
Range("D5").Select
ActiveCell.FormulaR1C1 = "=2340+10"
Range("D12").Select
Selection.ClearContents
Range("E10").Select
ActiveCell.FormulaR1C1 = "=1338+20"
Range("E13").Select
Selection.ClearContents
Range("D11").Select
ActiveCell.FormulaR1C1 = "=10"
Range("D14").Select
Selection.ClearContents
Range("D17").Select
ActiveCell.FormulaR1C1 = "=896+10"
Range("D24").Select
Selection.ClearContents
Range("E22").Select
ActiveCell.FormulaR1C1 = "=844+20"
Range("E25").Select
Selection.ClearContents
Range("F21").Select
End Sub

 

[veyselemre]

Sub birlestir()
    [g:k].Delete shift:=xlLeft
    [a:e].Copy [g:k]
    hSon = [h65536].End(3).Row
    For i = 2 To hSon - 1
        For ii = i + 1 To hSon
            If Cells(i, "H") & Cells(i, "I") = Cells(ii, "H") & Cells(ii, "I") Then
                Cells(i, "J") = Cells(i, "J") + Cells(ii, "J"): Cells(ii, "J") = 0
                Cells(i, "K") = Cells(i, "K") + Cells(ii, "K"): Cells(ii, "K") = 0
            End If
        Next ii
    Next i
End Sub

 

[usta07]

Sayın Veyselemre çözümü sunmuş ama alternatif olsun diyorsan pivot table çözüm ekte

 

[ANTALYA 01]

D

Merhabalar

Cevabınız için teşekkür ederim.Tam isitedğim gibi olmuş fakat bu makro sadece a.b.c.d.e Sütunları için olursa tam istediim gibi olacak.

 

[ANTALYA 01]

H

Ben yapmaya çalıştım olmadı.

Sub birlestir()
[a:e].Delete shift:=xlLeft
hSon = [h65536].End(3).Row
For i = 2 To hSon - 1
For ii = i + 1 To hSon
If Cells(i, "B") & Cells(i, "C") = Cells(ii, "B") & Cells(ii, "C") Then
Cells(i, "D") = Cells(i, "D") + Cells(ii, "D"): Cells(ii, "D") = 0
Cells(i, "E") = Cells(i, "E") + Cells(ii, "E"): Cells(ii, "E") = 0
End If
Next ii
Next i
End Sub

 

[veyselemre]

Sub birlestir()
    bSon = [B65536].End(3).Row
    For i = 2 To bSon - 1
        For ii = i + 1 To bSon
            If Cells(i, "B") & Cells(i, "C") = Cells(ii, "B") & Cells(ii, "C") Then
                Cells(i, "D") = Cells(i, "D") + Cells(ii, "D"): Cells(ii, "D") = 0
                Cells(i, "E") = Cells(i, "E") + Cells(ii, "E"): Cells(ii, "E") = 0
            End If
        Next ii
    Next i
End Sub

 

[ANTALYA 01]

F

Teşekkür ederim.