Bir hücredeki kelimeleri sayma

[tamer42]

Merhaba,
bir hücre içinde aşağıdaki gibi birbirinin aynısı bir çok kelimeler olsun, burada her harf bir kelime;

bunu kısaltmak adına her bir kelimeden kaç adet varsa, "kelime * adet" şekline yazmanın pratik bir yöntemi var mıdır?

Veri: a, b, d, c, e, a, b, e, a

Sonuç: a*3, b*2, c, d, e*2

teşekkürler, iyi pazarlar.

 

[metin_0606]

Merhaba,
bir hücre içinde aşağıdaki gibi birbirinin aynısı bir çok kelimeler olsun, burada her harf bir kelime;

bunu kısaltmak adına her bir kelimeden kaç adet varsa, "kelime * adet" şekline yazmanın pratik bir yöntemi var mıdır?

Veri: a, b, d, c, e, a, b, e, a

Sonuç: a*3, b*2, c, d, e*2

teşekkürler, iyi pazarlar.

Veri olan sütunu mouse ile seçin sonra makroyu çalıştırın

Sub kelime_say()
    Dim rng As Range
    Dim row As Range
    Dim col As Range
    Dim cell As Range
    Dim ws As Worksheet
    Dim wsNumber As Long
    wsNumber = 1
    Set rng = Selection
    For Each col In rng.Columns
        Dim BigString As String, I As Long, J As Long, K As Long
        BigString = ""
        For Each cell In col.Cells
            BigString = BigString & " " & cell.Value
        Next cell
        BigString = Trim(BigString)
        ary = Split(BigString, " ")
        Dim cl As Collection
        Set cl = New Collection
        For Each a In ary
            On Error Resume Next
            cl.Add a, CStr(a)
        Next a
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        ws.Name = "F" & CStr(wsNumber)
        wsNumber = wsNumber + 1
        Worksheets(ws.Name).Cells(1, "A").Value = col.Cells(1, 1).Offset(-1, 0).Value
        For I = 1 To cl.Count
            v = cl(I)
            Worksheets(ws.Name).Cells(I + 1, "A").Value = v
            J = 0
            For Each a In ary
                If LCase(a) = LCase(v) Then J = J + 1
            Next a
            Worksheets(ws.Name).Cells(I + 1, "B") = J
        Next I
    Next col
End Sub

 

[Korhan Ayhan]

Alternatif;

Kullanıcı tanımlı fonksiyon ile çözüm ektedir.

 

[tamer42]

Alternatif;

Kullanıcı tanımlı fonksiyon ile çözüm ektedir.

Metin ve Korhan hocam ilginize çok teşekkür ederim.
iyi haftalar.