Birleştir ve adet bazında topla

[OKUROGLU3375]

Selamlar;
G sütunu birleştir uygulaması örnek olarak yapılmıştır.
G sütununda uygulanmış birleştir formüllerinin isim ve ebat bazında (isimsel olarak) teke düşürülmesi ve bunlara ait D sütununda ki adetlerin isim bazında toplanması için yardımlarınızı rica ederim.

 

[Necdet]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?

Public Sub EbatTopla()

Dim i   As Long
Dim ebt As Variant
Dim item As Variant
Dim key As Variant

With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 4 To Cells(Rows.Count, "A").End(3).Row
        ebt = Cells(i, "A") & " " & Cells(i, "B") & " x " & Cells(i, "C")
        If Not .exists(ebt) Then
            .Add ebt, Cells(i, "D")
        Else
            .item(ebt) = .item(ebt) + Cells(i, "D")
        End If
    Next i
    
    key = .keys
    item = .items
    Range("G4").Resize(UBound(key) + 1, 1) = Application.WorksheetFunction.Transpose(key)
    Range("H4").Resize(UBound(item) + 1, 1) = Application.WorksheetFunction.Transpose(item)
End With

End Sub

 

[OKUROGLU3375]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?

Public Sub EbatTopla()

Dim i   As Long
Dim ebt As Variant
Dim item As Variant
Dim key As Variant

With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 4 To Cells(Rows.Count, "A").End(3).Row
        ebt = Cells(i, "A") & " " & Cells(i, "B") & " x " & Cells(i, "C")
        If Not .exists(ebt) Then
            .Add ebt, Cells(i, "D")
        Else
            .item(ebt) = .item(ebt) + Cells(i, "D")
        End If
    Next i
   
    key = .keys
    item = .items
    Range("G4").Resize(UBound(key) + 1, 1) = Application.WorksheetFunction.Transpose(key)
    Range("H4").Resize(UBound(item) + 1, 1) = Application.WorksheetFunction.Transpose(item)
End With

End Sub

İlginize teşekkür ederim. Excel formül yoluyla yapmamız mümkün mü? vba olarak çok fazla değişkenlik gösterecek tablo, bu kısa özetti...

 

[Necdet]

değişkenlik gösterecek derken?

 

[Korhan Ayhan]

Alternatif..

Formüllerle çözümler.. Eski ve yeni sürümler için 2 ayrı örnek bulunmaktadır. Eğer dahada eski sürümlerde kullanılacaksa EĞERHATA bölümü revize edilmelidir.

 

[OKUROGLU3375]

Alternatif..

Formüllerle çözümler.. Eski ve yeni sürümler için 2 ayrı örnek bulunmaktadır. Eğer dahada eski sürümlerde kullanılacaksa EĞERHATA bölümü revize edilmelidir.

Korhan bey ilginize teşekkür ederim. eski sürüm dediğiniz tam istediğim gibi olmuş. Teşekkürler.