Dataları süzüp gruplama

[hüseyintok]

Merhaba B stununda ki datanın (Satış Yeri) listesinden 1 tane alarak F stununda kaçtane C stununda ki (Satış kodu) G stununa gruplamasını VBA ile yapmak istiyorum ama başaramadım.

 

[ÖmerFaruk]

Aşağıdaki kodu bir modül içine ekleyip çalıştırabilirsiniz.

Sub Grupla()
    Dim Dict As Object, son As Integer, sh As Worksheet, Veri As Variant
    Set Dict = CreateObject("Scripting.Dictionary")
    Set sh = Worksheets("A SAYFASI")
    son = sh.Range("B" & Rows.Count).End(3).Row
    Veri = sh.Range("B4:C" & son).Value
    ReDim Liste(1 To UBound(Veri), 1 To 3)
    For i = LBound(Veri) To UBound(Veri)
        If Not Dict.Exists(Veri(i, 1)) Then
            Say = Say + 1
            Dict.Add Veri(i, 1), Say
            Liste(Say, 1) = Say
            Liste(Say, 2) = Veri(i, 1)
            Liste(Say, 3) = Veri(i, 2)
        Else
            Liste(Dict(Veri(i, 1)), 3) = Liste(Dict(Veri(i, 1)), 3) & "-" & Veri(i, 2)
        End If
    Next i
    If Say > 0 Then
        sh.Range("E4:G" & Rows.Count).Clear
        sh.Range("E4").Resize(Say, 3) = Liste
        sh.Range("G4").Resize(Say, 1).HorizontalAlignment = xlHAlignLeft
    End If
End Sub