Mükerrer kayıtlarda tek satır toplam alma

[Bakigemlik]

MErhaba,

Ek dosyada aynı referans da olan verileri sadece tek satırda toplatmak münmü,

ek dosyada nasıl olması gerektiğini manuel olarak yaptım,

Teşekkürler,

 

[Ömer]

Merhaba,

Bu şekilde deneyin. Veriler E:F sütununa özet şekilde listelenir.

Sub Ozet_Topla()
 
    Dim d As Object, i As Long, s, deg
 
    Set d = CreateObject("Scripting.Dictionary")

    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
       deg = Cells(i, "A")
       If Not d.exists(deg) Then
           s = Cells(i, "B")
           d.Add deg, s
       Else
           s = d.Item(deg)
           s = s + Cells(i, "B")
           d.Item(deg) = s
       End If
    Next i
    
    Range("E2:F" & Rows.Count).ClearContents
    Range("E2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))

End Sub

.

 

[Bakigemlik]

Ömer Bey Merhaba,

Satırlarda hata var gibi görünüyor,

Toplamı ekteki gibi yapabilir mi aynı referans varsa boş geçip sonrasında tekrar diğer veriler için devam etmeli

 

[Ömer]

Satırlarda bir hata yok. İstediğiniz gibi özet tabloyu farklı sütunda yapıyor.

Sorunuzu detaylı açıklamanızı rica ederim.

.

 

[Bakigemlik]

Satırlarda bir hata yok. İstediğiniz gibi özet tabloyu farklı sütunda yapıyor.

Sorunuzu detaylı açıklamanızı rica ederim.

.

Aynı referanslar için tek toplam almalaı tekrar eden referans için ilk toplamdan sonrasını boş geçip daha sonra bir sonraki için işleme devam etmeli

 

[Erdem Akdemir]

Sayfa2'nin bir önemi var mı?

=EĞER(EĞERSAY(A$3:A3;A3)=1;ETOPLA(Sayfa1!$A$3:$A$8;Sayfa1!$A3;Sayfa1!$B$3:$B$8);"")

 

[veyselemre]

Dediğiniz gibi, D sütununa sadece toplam alır.

Sub usttekineTopla()
    Dim i As Long, ref As String
    With CreateObject("Scripting.Dictionary")
        For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
            ref = Cells(i, "A")
            If Not .exists(ref) Then
                .Add ref, Cells(i, "B")
            Else
                .Item(ref) = .Item(ref) + Cells(i, "B")
                bossay = bossay + 1
                .Add "boskey" & bossay, Empty
            End If
        Next i
        Range("D3:D" & Rows.Count).ClearContents
        Range("D3").Resize(.Count) = Application.Transpose(.items)
    End With
End Sub

 

[halit3]

Mesaj silndi

 

[Bakigemlik]

Herkese desteklerinden dolayı teşekkürler ben formül olan seçeneği kullandım

Formül bende görünen yanlış yok yanlış olma ihtimali yoktur demi