Textleri Gruplama yaparak count etmek

[mktemel]

Merhaba;

Mevcut örnekleri inceledim ve kendime uyarlamaya çalıştım ancak başarılı olamadım.

Sorunum ;

A kolonunda her bir hücrede kelimeler mevcut bu kelimeler bir yada birden fazla kelimeler içerebilmekte.

Amacım her boşultan onceki kelimeyi gruplamak ve kac adet oldugunu saydırmak.

Ekli ornek tablomda elımnden geldiğince açıkca anlatmaya çalıştım.

Yardımcı olabilcek arkadaşlara şimdiden teşekkürler

 

[Orion1]

Dosyanız ektedir.

Sub grubla()
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Range("D2:Z65536").Clear
j = grub(1, "D2")
j = grub(2, "G2")
j = grub(3, "J2")
j = grub(4, "M2")
j = grub(5, "P2")
Application.ScreenUpdating = True
End Sub
Function grub(sayi As Integer, sutun As String)
Dim i As Long, z As Object, a, sat As Long
Set z = CreateObject("scripting.dictionary")
For i = 1 To Cells(65536, "A").End(xlUp).Row
    a = Split(Cells(i, "A").Value, " ")
    If sayi - 1 <= UBound(a) Then
        If Not z.exists(a(sayi - 1)) Then
            z.Add a(sayi - 1), 1
            Erase a
            Else
            z.Item(a(sayi - 1)) = z.Item(a(sayi - 1)) + 1
            Erase a
        End If
    End If
Next i
On Error Resume Next
Range(sutun).Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.Items))
End Function

 

[mktemel]

Çok tesekkür ederim. Ellerinize sağlık.

 

[Orion1]

Çok tesekkür ederim. Ellerinize sağlık.

Rica ederim.
İyi çalışmalar.