Tool Text Statistik?

Question

Tool Text Statistik?

Ich benötige für einen Text eine statische Auswertung, wie oft einzelne Wörter vorkommen. Sodass man erkennen kann welche Wörter besonders häufig verwendet worden sind. Es geht dabei um mehrere Interviews die in textform vorliegen. Kennt ihr Tools oder PlugIn für Word oder evtl eine Webseite ?

1 Antwort

BerchGerch · Answer 1

Hallo,

ich habe dafür mal ein Makro im Internet gefunden, das ich leicht angepasst habe.

Das Makro erstellt ein neues Dokument, in dem alle Wörter und Zeichen des Dokuments, von dem die Wörter gezählt werden sollen, aufgelistet werden.

Bei der Sortierreihenfolge ist es ein wenig nachteilig, dass die Zahlen nicht nach Größe, sondern nach Reihenfolge der Ziffern sortiert werden. Das heißt die Zahl 45 wird bei den Vierern einsortiert und kommt in der Sortierreihenfolge erst nach beispielsweise 8, auch wenn 45 natürlich größer als 8 ist.

Des Weiteren kann es sein, dass Word bei großen Dokumenten (scheinbar) abstürzt. Falls dies passiert, erst einmal abwarten; falls sich lange wirklich nichts mehr tut, hilft nur Schließen und Dokument neu starten.

Falls du Fragen hast, melde dich bitte.

Gruß, BerchGerch

====

Hier das Makro:

Sub AlleWorteListen()

    Dim i As Integer, k As Integer
    Dim Anz As Integer, AnzW As Integer, AnzW2 As Integer
    Dim aWorte(), aWorte2()
    Dim Wort As String
    Dim newDoc As Document
    Dim found As Boolean

    Anz = ActiveDocument.Words.Count
    ReDim aWorte(Anz, 2)

    If Anz > 0 Then
        For i = 1 To Anz
            found = False
            Wort = ActiveDocument.Words(i)
            If Len(Wort) > 1 Then
                For k = 1 To i
                    If aWorte(k, 1) = Wort Then
                    found = True
                        AnzW = IIf(aWorte(k, 2) = Null, 0, aWorte(k, 2))
                        aWorte(k, 2) = AnzW + 1
                    End If
                Next k
                If Not found Then
                    aWorte(i, 1) = Wort
                    aWorte(i, 2) = 1
                End If
            End If
        Next i
    End If

    'Jetzt die leeren Zeilen entfernen
    AnzW2 = 0
    For i = 1 To UBound(aWorte)
        If Len(Trim(aWorte(i, 1))) > 0 Then AnzW2 = AnzW2 + 1
    Next i
    ReDim aWorte2(AnzW2, 2)
    k = 0
    For i = 1 To UBound(aWorte)
        If Len(Trim(aWorte(i, 1))) > 0 Then
            k = k + 1
            aWorte2(k, 1) = aWorte(i, 1)
            aWorte2(k, 2) = aWorte(i, 2)
        End If
    Next i

    Set newDoc = Documents.Add
    For i = 1 To UBound(aWorte2)
       newDoc.Content.InsertAfter aWorte2(i, 2) & " x gefunden: " & aWorte2(i, 1) & Chr(13)
    Next i

    newDoc.Content.Sort SortOrder:=wdSortOrderDescending

    With Selection
        .WholeStory
        .ParagraphFormat.TabStops.ClearAll
        .ParagraphFormat.TabStops.Add _
            Position:=CentimetersToPoints(6), _
            Alignment:=wdAlignTabLeft, _
            Leader:=wdTabLeaderDots
        .HomeKey Unit:=wdStory
    End With

End Sub