Wortwiederholungen zählen

Dieses Thema Wortwiederholungen zählen im Forum "Microsoft Office Suite" wurde erstellt von fritzorcolix, 25. Dez. 2009.

Thema: Wortwiederholungen zählen Gibt es ein Programm (ausser dem umfangreichen und teuren Papyrus), mit dem es möglich ist, in einem Text die Wörter...

  1. Gibt es ein Programm (ausser dem umfangreichen und teuren Papyrus), mit dem es möglich ist, in einem Text die Wörter so zu zählen, dass man eine Liste erhält, in der steht, wie oft jedes Wort im Text vorkommt?
    Also eine Art Stilanalyse.
    (Ich hatte früher mal so ein Programm, aber das brauchte DOS; deshalb habe ich es irgendwann gelöscht.?)
     
  2. Hallo fritzorcolix,

    ich hab dir mal ein Wordmakro geschrieben, das im aktuelle Dokument die Wortvorkommen zählt und diese dann in einem neuen Dokument sortiert in einer Tabelle ausgibt.

    Gruß Matjes :)

    Code:
    Option Explicit
    
    Type my_WortvorkommenZaehlen_struct
     sWort  As String
     lZaehler As Long
    End Type
    Sub WortvorkommenZaehlen_Content()
     
     Dim Wortliste() As my_WortvorkommenZaehlen_struct, WortListeZaehler As Long
     Dim oBereich As Range
     
     Set oBereich = ActiveDocument.Content
     Call WortvorkommenZaehlen(oBereich, Wortliste(), WortListeZaehler)
     If WortListeZaehler < 1 Then GoTo AUFRAEUMEN
     Call WortlisteSortieren(Wortliste(), WortListeZaehler)
     Call WortlisteInNeuemDokumentAlsTabelleAusgeben(Wortliste(), WortListeZaehler)
     
    AUFRAEUMEN:
     Set oBereich = Nothing
    End Sub
    
    '***********************************************************************************
    Private Function WortvorkommenZaehlen(oBereich As Range, _
                       Wortliste() As my_WortvorkommenZaehlen_struct, _
                       WortListeZaehler As Long)
     
     Dim oWort As Object
     Dim sWort As String, sAnfang As String
     Dim x As Long, lInd As Long
     
     WortListeZaehler = 0
     ReDim Wortliste(1 To 100)
     
     For Each oWort In ActiveDocument.Content.Words
        
      sWort = oWort.Text
      sAnfang = Left(sWort, 1)
      Select Case sAnfang
       Case a To z, A To Z, ß, ä, Ä, ö, Ö, ü, Ü
        sWort = Trim(sWort)
        lInd = 0
        For x = 1 To WortListeZaehler
         If Wortliste(x).sWort = sWort Then lInd = x: Exit For
        Next
        If lInd <> 0 Then
         Wortliste(x).lZaehler = Wortliste(x).lZaehler + 1
        Else
         WortListeZaehler = WortListeZaehler + 1
         If UBound(Wortliste()) < WortListeZaehler Then
          ReDim Preserve Wortliste(1 To UBound(Wortliste()) + 100)
         End If
         Wortliste(WortListeZaehler).sWort = sWort
         Wortliste(WortListeZaehler).lZaehler = 1
        End If
      End Select
     Next
    AUFRAEUMEN:
     Set oWort = Nothing
    End Function
    '***********************************************************************************
    Private Function WortlisteSortieren(Wortliste() As my_WortvorkommenZaehlen_struct, _
                      WortListeZaehler As Long)
     Dim tmp As my_WortvorkommenZaehlen_struct
     Dim vRet As Variant
     Dim x As Long, y As Long
     Dim sWort1 As String, sWort2 As String
     
     For x = 1 To WortListeZaehler - 1
      For y = x + 1 To WortListeZaehler
       sWort1 = Wortliste(x).sWort
       sWort2 = Wortliste(y).sWort
       vRet = StrComp(sWort1, sWort2, vbTextCompare)
       If IsNull(vRet) Then
        If Len(sWort2) = 0 Then
         tmp = Wortliste(x)
         Wortliste(x) = Wortliste(y)
         Wortliste(y) = tmp
        End If
       ElseIf vRet = 1 Then
        tmp = Wortliste(x)
        Wortliste(x) = Wortliste(y)
        Wortliste(y) = tmp
       End If
       
      Next
     Next
    
    End Function
    
    '***********************************************************************************
    Private Function WortlisteInNeuemDokumentAlsTabelleAusgeben( _
                      Wortliste() As my_WortvorkommenZaehlen_struct, _
                      WortListeZaehler As Long)
     Dim oDoc As Document, oTab As Table
     Dim x As Long
     
     Set oDoc = Documents.Add
     oDoc.Content.InsertAfter Ergebnis: & vbCrLf
     Selection.Move wdStory
     Set oTab = oDoc.Tables.Add(Selection.Range, NumRows:=WortListeZaehler, NumColumns:=2)
     For x = 1 To WortListeZaehler
      oTab.Cell(x, 1).Range.Text = Wortliste(x).sWort
      oTab.Cell(x, 2).Range.Text = Wortliste(x).lZaehler
     Next
    AUFRAEUMEN:
     Set oDoc = Nothing: Set oTab = Nothing
    End Function
     
  3. Hallo Matjes
    Ich bin kein Experte und bekomme das Makro nicht kompiliert
    Bei Private Function Wortvorkommenzaehlen kommt die Fehlermeldung:
    Fehler beim Kompilieren
    Benutzerdefinierter Typ nicht definiert
    gruss fritzorcolix
     
  4. Hallo Matjes,

    wie immer, einfach Perfect, das Makro läuft Super!

    @fritzorcolix

    Den Code im VBA-Editor in ein Modul einfügen,
    dann sollte es gehen.

    In Word ALT+F11
    Einfügen
    Modul
    rechts den Code einfügen, zurück zum Dokument
    und das Makro WortvorkommenZaehlen_Content ausführen!
     
  5. Danke Matjes
    Jetzt hat es geklappt
    alles Gute für 2010
    fritz
     
Die Seite wird geladen...

Wortwiederholungen zählen - Ähnliche Themen

Forum Datum
Excel Buchstabenkombination z.B. "ABC" durch Zahlenkombination z.B."1,2,3" ersetzen Microsoft Office Suite 29. Juli 2013
[INFO] Software-Pirat muss 500.000 Euro Strafe zahlen Windows 7 Forum 18. März 2010
Access Zeilen zählen und dann für jeden Datensatz +1 Windows XP Forum 25. Juli 2013
Excel 2010 - Spalten automatisch zählen Windows XP Forum 22. Apr. 2013
Warum undeutliche Zahlen- und Buchstabencodes Sonstiges rund ums Internet 28. Dez. 2012