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
Excele Tablodan meyveleri excele aktarırsanız exceldeki kod dictionary ile alttaki kod gibi olur Excel için.
![[Resim: do.php?img=9948]](https://resim.accesstr.net/do.php?img=9948)