Häufigkeit der verschiedenen Wörter aufzählen lassen (Word)

Dieses Thema Häufigkeit der verschiedenen Wörter aufzählen lassen (Word) im Forum "Microsoft Office Suite" wurde erstellt von Lenni87, 9. Feb. 2006.

Thema: Häufigkeit der verschiedenen Wörter aufzählen lassen (Word) Hallo, ich benötige Hilfe. Und zwar suche ich eine Funktion bei MS Office (Word oder Frontpage), welche mir die...

  1. Hallo,

    ich benötige Hilfe. Und zwar suche ich eine Funktion bei MS Office (Word oder Frontpage), welche mir die einzelnen Wörter zählt. Und zwar nicht wie viele Wörter auf der Seite dann sind, sondern von welchem Wort wie viele gefunden wurden (einzeln). Ich benötige das für den Inhalt einer Homepage. Gibt es vielleicht Add-Ins oder Plug-Ins ?? Wäre super, wenn mir jemand helfen kann?

    Vielen Dank im Voraus

    Gruß Lenni
     
  2. Hallo Lenni87,

    ich hab dir einen Word-Makro Word_StatistikWorte() zusammengebaut.
    Er sollte in einem extra Modul in der Normal.dot plaziert werden.

    Der Makro analysiert das aktive Dokument und schreibt anschliessend das Ergebnis in Form einer aufsteigend sortierten Tabelle in ein neues Dokument.

    Die Konstante c_GROSSKLEINSCHREIBUNG_BEACHTEN ist auf False gesetzt.
    Mit dieser Einstellung unterscheidet das Makro Gross/Kleinschreibung nicht.
    Wenn du eine Unterscheidung wünscht, ändere den Wert der Konstanten auf True.

    Gruß Matjes :)
    Code:
    Option Explicit
    Private Type myWorteStatistik_structure
      s_Wort As String
      l_cnt  As Long
    End Type
    
    Private Const c_GROSSKLEINSCHREIBUNG_BEACHTEN As Boolean = False
    Private Const c_WORT_MIMIMAL_LAENGE = 2
    Private Const c_BINDESTRICHERSATZ = xxyyzzbbbzzyyxx
    '************************************************************
    Sub Word_StatistikWorte()
    '************************************************************
    ' Zählt die Worte des aktiven Dokuments.
    ' Erzeugt ein temporäres Dokument und gibt darauf ein Tabelle
    ' mit den Spalten->Wort' und Häufigkeit aus
    '
    ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ' !!! geschützter Bindestrich und Bindestrich werden vor der Zählung durch
    ' !!! c_BINDESTRICHERSATZ ersetzt, da Word diese sonst als zwei Worte betrachtet.
    ' !!! Nach der Zählung wird diese Ersetzung wieder korrigiert
    ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      
      Dim doc_org As Document, doc As Document, mytab As Table, myword As Variant
      Dim f() As myWorteStatistik_structure, f_cnt As Long
      Dim s_Wort As String
      Dim l_Anz As Long, l_ind As Long, x As Long, pos As Long
      
      Set doc_org = ActiveDocument
      Application.ScreenUpdating = False
      
      
     ->erstmal eine Text-Kopie vom Original anlegen -> keine Tabellen mehr
      Set doc = Documents.Add
      doc.Content.Text = doc_org.Content.Text
      
     ->im Dokument alle Steuerzeichen durch Leerzeichen ersetzen
      Call SteuerZeichenDurchLeerzeichenErsetzen(doc.Content)
      
     ->alle Worte abarbeiten
      f_cnt = 0: ReDim Preserve f(1 To 1)
      For Each myword In doc.Words
        s_Wort = myword
            
        s_Wort = Trim(s_Wort)
       ->Minimallänge ?
        If Len(s_Wort) < c_WORT_MIMIMAL_LAENGE Then GoTo NAECHSTESWORT
        
       ->GroßKleinschreibung beachten ?
        If Not c_GROSSKLEINSCHREIBUNG_BEACHTEN Then s_Wort = LCase(s_Wort)
       ->Wort suchen
        l_ind = 0
        For x = 1 To f_cnt
          If s_Wort = f(x).s_Wort Then l_ind = x: Exit For
        Next
       ->Wort schon vorhanden
        If l_ind > 0 Then
         ->schon vorhanden -> Zähler erhöhen
          f(l_ind).l_cnt = f(l_ind).l_cnt + 1
        Else
         ->nicht vorhanden -> neu anlegen
          f_cnt = f_cnt + 1: ReDim Preserve f(1 To f_cnt)
          f(f_cnt).l_cnt = 1:  f(f_cnt).s_Wort = s_Wort
        End If
    
    NAECHSTESWORT:
      Next
     ->temporäre Kopie schliessen
      doc.Close Savechanges:=False
      Application.ScreenUpdating = True
      
     ->neues Dokument anlegen
      Set doc = Documents.Add
      doc.Content.Text = 
      Selection.InsertAfter Statistik Wortanzahl   Datei:  & doc.Name & vbCr & vbCr
      Selection.Collapse direction:=wdCollapseEnd
     ->Tabelle einfügen
      Set mytab = doc.Tables.Add(Range:=Selection.Range, NumRows:=f_cnt + 1, NumColumns:=2)
      With mytab.Cell(1, 1).Range: .Text = Wort:   .Bold = True: End With
      With mytab.Cell(1, 2).Range: .Text = Anzahl: .Bold = True: End With
      For x = 1 To f_cnt
        s_Wort = f(x).s_Wort
        Do
          pos = InStr(1, s_Wort, c_BINDESTRICHERSATZ)
          If pos = 0 Then Exit Do
         ->BINDESTRICHERSATZ durchBindestrich ersetzen
          s_Wort = Left(s_Wort, pos - 1) & Chr(30) & _
                   Right(s_Wort, Len(s_Wort) - pos + 1 - Len(c_BINDESTRICHERSATZ))
        Loop
        mytab.Cell(x + 1, 1).Range.Text = s_Wort
        mytab.Cell(x + 1, 2).Range.Text = f(x).l_cnt
      Next
     ->Tabelle sortieren
      mytab.Sort _
        ExcludeHeader:=True, _
        FieldNumber:=1, _
        SortFieldType:=wdSortFieldAlphanumeric, _
        SortOrder:=wdSortOrderAscending, _
        CaseSensitive:=c_GROSSKLEINSCHREIBUNG_BEACHTEN
        
    AUFRAEUMEN:
      Set doc_org = Nothing: Set doc = Nothing:  Set mytab = Nothing: Set myword = Nothing
      
    End Sub
    Private Function SteuerZeichenDurchLeerzeichenErsetzen(r As Range)
      
      Dim x As Long
      
      Call myErsetzen(r, Chr(30), c_BINDESTRICHERSATZ)   ->geschützter Bindestrich   -> c_BINDESTRICHERSATZ
      Call myErsetzen(r, Chr(45), c_BINDESTRICHERSATZ)   ->Bindestrich               -> c_BINDESTRICHERSATZ
    
     ->Steuerzeichen durch Leerzeichen ersetzen
      For x = 1 To 30
      Call myErsetzen(r, Chr(x),  )     'Steuerzeichen (1 -30)     -> Leerzeichen
      Next
      
      Call myErsetzen(r, Chr(31), )     'bedingter Trennstrich     -> löschen
      Call myErsetzen(r, Chr(151), )   ->Langer Gedankenstrich     -> löschen
      Call myErsetzen(r, Chr(150), )   ->Gedankenstrich            -> löschen
      Call myErsetzen(r, Chr(160),  )   'geschütztes Leerzeichen   -> Leerzeichen
      Call myErsetzen(r, Chr(182),  )   'Absatz                    -> Leerzeichen
      Call myErsetzen(r, Chr(133),  )   'Auslasspunkte             -> Leerzeichen
      Call myErsetzen(r, Chr(145),  )   'einf. öffnendes     Anfz. -> Leerzeichen
      Call myErsetzen(r, Chr(146),  )   'einf. schliessendes Anfz. -> Leerzeichen
      Call myErsetzen(r, Chr(147),  )   '      öffnendes     Anfz. -> Leerzeichen
      Call myErsetzen(r, Chr(148),  )   '      schliessendes Anfz. -> Leerzeichen
      
      For x = 10 To 2 Step -1
      Call myErsetzen(r, String(x,  ),  ) ->doppelte Leerzeichen -> Leerzeichen
      Next
    End Function
    Private Function myErsetzen(r As Range, s_Text As String, s_Ersetzen As String)
      Selection.Find.ClearFormatting
      Selection.Find.Replacement.ClearFormatting
      With r.Find
        .Text = s_Text: .Replacement.Text = s_Ersetzen: .Wrap = wdFindContinue: .Format = False
      End With
      r.Find.Execute Replace:=wdReplaceAll
    End Function
     
  3. Da ich mich mit Word nicht so sehr genau auskenne (Makros), wollte ich fragen, wie genau ich vorgehen muss mit der Normal.dot . Wäre nett, wenn du mir in kurz beschriebenen Schritten genau erklären könntest, wie ich genau vorgehen muss und wie ich das Endprodukt dann in meinem Dokument ausführe. Vielen Dank
     
  4. Hallo lenni,

    also kurze Anleitung:

    a) Word öffnen
    b) VB-Editor öffnen (mit Alt+F11)
    c) im Project-Fenster Normal selektieren
    d) rechte Maustaste-> einfügen Modul
    e) per Copy and Paste den Code einfügen
       (gesamten Text im grauen Kasten oben)
    f) Normal speichern (mit Strg+S)
    g) VB-Editor schliessen (mit Alt+Q)

    Den Makro kannst Du ab jetzt in Word folgendermaßen aufrufen:

    Entweder über

    Extras->Makro->Makros->Word_StatistikWorte auswählen->Button Ausführen

    oder

    Alt+F8 -> Doppelklick auf Word_StatistikWorte

    Gruß Matjes :)
     
Die Seite wird geladen...

Häufigkeit der verschiedenen Wörter aufzählen lassen (Word) - Ähnliche Themen

Forum Datum
Funktion zur Häufigkeitserrechnung gesucht - Excel Windows XP Forum 10. Apr. 2006
häufigkeit von programmzugriffen ermitteln Windows XP Forum 6. Feb. 2006
Favoritensortierung nach Häufigkeit der Aufrufe Web-Browser 29. Nov. 2005
Sortierung nach Häufigkeit Windows XP Forum 31. Juli 2005
Migration zwischen verschiedenen Benutzerkonten? Windows 8 Forum 21. Sep. 2014