Tekrar eden kelime sayısını bulma...

[tahsinanarat]

Konu ile ilgili evren hocamın evvelce sunduğu kodları deneyiniz
'EN ÇOK OLAN (SUTUNDA)
'kodları yazan : Evren Gizlen

Function EN_COK_OLAN(alan As Range)
Dim z As Object, hcr As Range
Dim cok As Long, isim As String
'*******************************************************
Set z = CreateObject("Scripting.Dictionary")
For Each hcr In alan
If hcr.EntireRow.Hidden = False Then
    If Not z.exists(hcr.Value) Then
        z.Add hcr.Value, 1
        If cok < 1 Then
            cok = 1
            isim = hcr.Value
        End If
    Else
        z.Item(hcr.Value) = z.Item(hcr.Value) + 1
        If z.Item(hcr.Value) > cok Then
            cok = z.Item(hcr.Value)
            isim = hcr.Value
        End If
    End If
End If
Next
'*******************************************************
Set z = Nothing
EN_COK_OLAN = isim
End Function
'bu fonksiyon süzülen listedede çalışır

 

[gozeten]

Teşekkürler.

 

[tahsinanarat]

Sn. gozeten; Derginin kelimelerini taramak istediniz ama derginin arapca olduğundan hiç söz etmediniz, verdiğiniz örnek kelimelerle hiç alakası yok. Arapaca kelime sayımı ile ilgili hiç bir fikrim yok. word dosyasına aktardım ve saadece resimlerine bakınabildim.

 

[gozeten]

Sn. gozeten; Derginin kelimelerini taramak istediniz ama derginin arapca olduğundan hiç söz etmediniz, verdiğiniz örnek kelimelerle hiç alakası yok. Arapaca kelime sayımı ile ilgili hiç bir fikrim yok. word dosyasına aktardım ve saadece resimlerine bakınabildim.

Haklısınız vakit ayırdığınız için teşekkür ederim. Ben arapça olmasının bir fark doğuracağını düşünmemiştim. Verdiğim adı üzerinde örnekti aslı değildi.
Saygılar.

 

[kizilt07]

Dosyanız ekte.

Private Function Sirala(Liste As Variant)
Dim i As Integer, j As Integer, x As Variant
    For i = LBound(Liste) To UBound(Liste) - 1
        For j = i + 1 To UBound(Liste)
            If Liste(j, 1) > Liste(i, 1) Then
            'If StrComp(Liste(i, 0), Liste(j, 0), vbTextCompare) = 1 Then
                x = Liste(j, 0)
                Liste(j, 0) = Liste(i, 0)
                Liste(i, 0) = x
                x = Liste(j, 1)
                Liste(j, 1) = Liste(i, 1)
                Liste(i, 1) = x
            End If
        Next j
    Next i
    Sirala = Liste
End Function

Private Sub UserForm_Activate()
Dim hcr As Range, a As Long
ReDim myarr(1 To 2, 1 To 1)
For Each hcr In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
    If WorksheetFunction.CountIf(Range("A1:A" & hcr.Row), hcr.Value) = 1 Then
        a = a + 1
        ReDim Preserve myarr(1 To 2, 1 To a)
        myarr(1, a) = hcr.Value
        myarr(2, a) = WorksheetFunction.CountIf(Range("A1:A65536"), hcr.Value)
    End If
Next hcr
ListBox1.Column = myarr
Liste = ListBox1.List
ListBox1.List = Sirala(Liste)
Label1.Caption = "Toplam : " & ListBox1.ListCount
End Sub

üstad bu kodu eklediğimde ListBox1.Column = myarr bu kısımda hata veriyor.

elimde binlerce satırlık veri var ve bu verilerin tekrar eden kelimelerin frekanslarını vermesini istiyorum.