metindeki kelime sayısı kaç kez kullanıldığı

[kamilpeker]

- Yukarıda gönderdiğim örnek dosyayı açın,

- Makro güvenlik seviyesini "Orta" yapın,

Araçlar >> Makro >>Güvenlik

- Daha sonra, Araçlar >> Makro >> Makrolar penceresinde ilgili makroyu bulup (Test) çalıştırın.

Aynı şeye benim de ihityacım var. Ama "yukarıdaki örnek dosya" diyorsunuz, ben bulamadım.
Yardımcı olur musunuz?

 

[kamilpeker]

Sn Haluk Sizden eğer sizi çok uğraştırmayacaksa bir şey rica ediyorum.
metin kelimelerin adetlerini belirleyen makronuzu kullanıyorum. çok faydalı oldu teşekkür ederim. Ancak kelimeleri a dan z ye olarak alfabetik sıralarsa, bir de
adetler sütun olarak aynı hizada olsa çok daha iyi olacak:

ancak.........................2
apansız.......................1
başak.........................3



zalim...........................1 gibi

bu verileri excel e atmak istiyorum orda ek kök vb ayırmak vs... için ayrıca bu makro excel de işlermi ? selamlar

BEnim office 2007. Aynı şeye benim de ihtiyacım var. Bana da gönderebilir misiniz?

 

[Haluk]

Dosyadaki kodlar aşağıdadır;

    '**********************************************
    '*       Dokumandaki kelimeleri sayan kod.    *
    '*                                            *
    '*           Burasi Excel Vadisi ...          *
    '*                                            *
    '*                 Haluk ®                    *
    '*               03/10/2005                   *
    '*                                            *
    '**********************************************
    '*         Revizyon: Siralama ilave edildi    *
    '*                 Haluk ®                    *
    '*               06/01/2006                   *
    '*                                            *
    '**********************************************
    Sub Test()
        Dim NoWords As Long, i As Long, k As Long
        Dim MyColl As New Collection
        Dim Msg As String, MsgHeader As String, x As String, StrVal As String
        Dim MyRng As Range
       
        ActiveWindow.ActivePane.View.ShowAll = False
        NoWords = ActiveDocument.Words.Count
       
        For i = 1 To NoWords
            x = Trim(ActiveDocument.Words(i))
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "[,.!%&~`:+/*¹-]"
            StrVal = RegExp.Replace(x, "")
            MyColl.Add (StrVal)
        Next
       
        On Error Resume Next
        For i = 1 To NoWords
            For j = i + 1 To NoWords - 1
                If MyColl(i) = MyColl(j) Or MyColl(j) = "" Then
                    MyColl.Remove j
                End If
            Next
        Next
        
        For i = 1 To MyColl.Count - 1
            For j = i + 1 To MyColl.Count
                If LCase(MyColl(i)) > LCase(MyColl(j)) Then
                    Swap1 = MyColl(i)
                    Swap2 = MyColl(j)
                    MyColl.Add Swap1, Before:=j
                    MyColl.Add Swap2, Before:=i
                    MyColl.Remove i + 1
                    MyColl.Remove j + 1
                End If
            Next
        Next
        
        On Error GoTo 0
        For i = 1 To MyColl.Count
            k = 0
            For j = 1 To NoWords
                If Trim(ActiveDocument.Words(j)) = MyColl(i) Then
                    k = k + 1
                End If
                If Asc(MyColl(i)) = 13 Then GoTo ResumeFor:
            Next
            Msg = Msg & vbNewLine & MyColl(i) & " »» " & k & " adet"
ResumeFor:
        Next
        
        MsgHeader = vbCrLf & vbCrLf & "Rapor :"
        StartDoc = ActiveDocument.Content.End - 1
        EndDoc = ActiveDocument.Content.End - 1
        Set MyRng = ActiveDocument.Range(Start:=StartDoc, End:=EndDoc)
        MyRng.Text = MsgHeader & vbCrLf
        MyRng.ParagraphFormat.Alignment = wdAlignParagraphCenter
        MyRng.Bold = True
        MyRng.Font.Color = wdColorBlue
        MyRng.Underline = wdUnderlineThick
       
        StartDoc = ActiveDocument.Content.End - 1
        EndDoc = ActiveDocument.Content.End - 1
        Set MyRng = ActiveDocument.Range(Start:=StartDoc, End:=EndDoc)
        MyRng.Text = Msg
        MyRng.ParagraphFormat.Alignment = wdAlignParagraphLeft
        MyRng.Bold = True
        MyRng.Font.Color = wdColorBlack
        MyRng.Text = Msg
       
        Set MyRng = Nothing
        Set RegExp = Nothing
    End Sub