MÜkerrer Kayitlari Bulup Etopla Yapmak. Nasil?

[woyzeck]

Günaydın Arkadaşlar,
Mükerrer kayıtla ilgili olarak bi çok örnek buldum forumda. kesinlikle işime yaradılar. ama benim yapmaya çalıştığım tabloda ek olarak ETOPLA'da yapmasını istiyorum.

iki fonksiyonla ilgili bilgileri bulmama rağmen malesef yetersiz bilgimden kaynaklı bunları birleştiremedim.

Sorunum örnek tabloadaki değerlerin mükerrerlerini bulup daha sonrasında bunların karşılığına gelecek olan miktarların toplamıdır. Yani Makro ile yapımıdır.

Ekte örneğimi gönderiyorum. yardımcı olur iseniz çok sevinirim.

İyi çalışmalar dilerim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. D:E aralığına listeleme yapar.

Sub ÖZET_RAPOR()
    Columns("D:E").ClearContents
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=True
    [E1] = "MİKTAR"
    With Range("E2:E" & [D65536].End(3).Row)
    .Formula = "=SUMIF(A:A,D2,B:B)"
    .Value = .Value
    End With
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[Recep İpek]

Alternatif olarak aşağıdaki kodları deneyiniz.

Sub AktarTopla()
Dim a, i, n, b()
Set s1 = Sheets("Sayfa1")
'*******************************************
a = s1.Range("a2:b" & s1.[a65536].End(3).Row).Value
ReDim b(1 To UBound(a, 1), 1 To 3)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
           If Not IsEmpty(a(i, 1)) Then
                 If Not .exists(a(i, 1)) Then
                    n = n + 1
                    b(n, 1) = n
                    b(n, 2) = a(i, 1)
                    .Add a(i, 1), n
                  End If
                    b(.Item(a(i, 1)), 3) = b(.Item(a(i, 1)), 3) + a(i, 2)
            End If
    Next
End With
'*******************************************
s1.Range("e6:g100").ClearContents
s1.[e6].Resize(n, 3).Value = b
'*******************************************
MsgBox "Bitti"
Set s1 = Nothing
End Sub

 

[woyzeck]

@Cost Control ve @Ripek,
Her ikinize çok teşekkür ederim. İki kod da çalışıyor. aynı fonksiyonu yapan kod için iki farklı bakış açısı. eğitim için de süper bi döküman oldu.

Tekrar Teşekkür ederim..