Makro ile aynı değerleri tek satırda oluşturmak.

[_GÜRCAN_]

Merhabalar,
Örnek tabloda makro ile değer getirtmek istiyorum.
desteğinizi rica eder,
iyi çalışmalar dilerim.

 

[veyselemre]

Sub test()
    Dim veri, liste
    Dim i&, say&, sira&

    With Sheets("Sayfa1")
        veri = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 2).End(3).Row, "P")).Value
    End With
    
    ReDim liste(1 To UBound(veri), 1 To 4)
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            If Not .exists(veri(i, 5)) Then
                say = say + 1
                liste(say, 1) = veri(i, 1)
                liste(say, 2) = veri(i, 5)
                liste(say, 3) = Val(Replace(Replace(veri(i, 15), ".", ""), ",", "."))
                liste(say, 4) = 1
                .Item(veri(i, 5)) = say
            Else
                sira = .Item(veri(i, 5))
                liste(sira, 3) = liste(sira, 3) + Val(Replace(Replace(veri(i, 15), ".", ""), ",", "."))
                liste(sira, 4) = liste(sira, 4) + 1
            End If
        Next i
    End With
    
    With Sheets("TOPLAM TABLO")
        .Range("2:" & Rows.Count).ClearContents
        .Range("A2").Resize(say, 4).Value = liste
    End With

End Sub

 

[_GÜRCAN_]

Sub test()
    Dim veri, liste
    Dim i&, say&, sira&

    With Sheets("Sayfa1")
        veri = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 2).End(3).Row, "P")).Value
    End With
   
    ReDim liste(1 To UBound(veri), 1 To 4)
   
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            If Not .exists(veri(i, 5)) Then
                say = say + 1
                liste(say, 1) = veri(i, 1)
                liste(say, 2) = veri(i, 5)
                liste(say, 3) = Val(Replace(Replace(veri(i, 15), ".", ""), ",", "."))
                liste(say, 4) = 1
                .Item(veri(i, 5)) = say
            Else
                sira = .Item(veri(i, 5))
                liste(sira, 3) = liste(sira, 3) + Val(Replace(Replace(veri(i, 15), ".", ""), ",", "."))
                liste(sira, 4) = liste(sira, 4) + 1
            End If
        Next i
    End With
   
    With Sheets("TOPLAM TABLO")
        .Range("2:" & Rows.Count).ClearContents
        .Range("A2").Resize(say, 4).Value = liste
    End With

End Sub

veyselemre bey, teşekkürler iyi çalışmalar dilerim.