Farklı sütunlardaki satır değerlerinin toplamını benzersiz bir listede listelemek

[Alperen25]

Merhaba,

F1,F2,F3,F4 şeklinde 4 sütundan oluşan dinamik bir listem var. 0 değeri hariç diğer değerlerden 4 sütunda toplam kaç tane olduğunu bir listede listelemek istiyorum. etopla, çoketopla vs. denedim ama başarılı olamadım.

Örnek dosya ekledim.
Yardımlarınızı rica ediyorum.

 

[Hakan ERDOST]

=EĞERSAY($A$2:$D$15;H2)

Şeklinde "I" sütununa yazıp aşağı doğru çoğaltın.

 

[Alperen25]

Hakan bey desteğiniz için teşekkür ederim.
Dediğiniz gibi yaptım ama olmadı.
4
5
4
5
3
3
1
şeklinde bir liste çıktı.

Bir de zaten bizim H2 listemiz yok normalde.
Yani H2 sütunu hazır olarak gelmiyor.
Onu bizim elde etmemiz gerekiyor.
Ben test için göstermek amaçlı yazmıştım.
Elde etmek istediğimiz tablo H1:I8 tablosu.

 

[Ziynettin]

Makro ile;

 

[Alperen25]

Teşekkür ederim.

Bu şekilde bir çözüm geliştirdim ama biraz kasıyor gibi.
Elde etmek istediğimiz liste

20	8
25	10
30	12
40	10
50	6
60	10
100	6

Private Sub flanshesapla()
    
    Dim Sonsatir As Long
    Sheets("Sayfa1").Range("F:J").Clear
    
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    'Sonsatir = Range("A" & Rows.Count).End(xlUp).Row 'A sütununun son dolu satırı
    'Range("A2" & ":" & "A" & Sonsatir).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sonsatir = Range("F" & Rows.Count).End(xlUp).Row + 1
    Range("F" & Sonsatir).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sonsatir = Range("G" & Rows.Count).End(xlUp).Row + 1
    Range("G" & Sonsatir).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sonsatir = Range("F" & Rows.Count).End(xlUp).Row + 1
    Range("F" & Sonsatir).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sonsatir = Range("G" & Rows.Count).End(xlUp).Row + 1
    Range("G" & Sonsatir).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sonsatir = Range("F" & Rows.Count).End(xlUp).Row + 1
    Range("F" & Sonsatir).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sonsatir = Range("G" & Rows.Count).End(xlUp).Row + 1
    Range("G" & Sonsatir).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("I2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sonsatir = Range("I" & Rows.Count).End(xlUp).Row
    Range("I" & Sonsatir).Select
    
    ActiveSheet.Range("I2:" & "I" & Sonsatir).RemoveDuplicates Columns:=1, Header:=xlNo
    
    For i = 2 To Sonsatir
    
    If Range("I" & i).Value <> 0 Then
    Range("J" & i) = WorksheetFunction.SumIf(Range("F2:" & "F" & Sonsatir), Range("I" & i), Range("G2:" & "G" & Sonsatir))
    End If
    
    Range("J2").Select
    'Selection.AutoFill Destination:=Range("J2:" & "J" & Sonsatir)
    Range("J2:" & "J" & Sonsatir).Select
    
    Next i
    
    Range("I2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("I2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Sonsatir = Range("J" & Rows.Count).End(xlUp).Row
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SetRange Range("I2:" & "J" & Sonsatir)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Makro ile;

 

[Alperen25]

Kasmayan daha pratik bir çözümü olursa çok memnun olurum.

Teşekkür ederim.