Excele Tablodan meyveleri excele aktarırsanız exceldeki kod dictionary ile alttaki kod gibi olur Excel için.

Private Sub CommandButton1_Click()



    Dim aa As Object, rng As Range

    Dim son As Integer, k As Long

    

    [E:F].Clear

    Set aa = CreateObject("scripting.dictionary")

    aa.CompareMode = TextCompare

    Application.ScreenUpdating = False

    With Sheets("Sayfa1")

        For Each rng In .Range("A2", .Range("A" & Rows.Count).End(3))

            kes = Split(Replace(rng, " ", ""), ",")

            For k = LBound(kes) To UBound(kes)

                aa(kes(k)) = aa(kes(k)) + 1

            Next

        Next

        

        .Range("E1").Resize(aa.Count, 1) = Application.Transpose(aa.Keys)

        .Range("F1").Resize(aa.Count, 1) = Application.Transpose(aa.Items)

        

    End With

    Application.ScreenUpdating = True

    

    Set rng = Nothing

    Set aa = Nothing

    son = Empty

    kes = vbNullString



End Sub