Wörterranking erstellen

[MrNeugierig]

Guten Tag,

ich möchte gerne ein "Wörterranking" erstellen, wo das Programm für mich aus
einem Text die Wörter raussucht, sodass die Häufigkeit der einzelnen Begriffe kategorisch
aufgelistet werden. Besteht die Möglichkeit das mit Excel zu realisieren?

Vom Prinzip würde es so ausschauen:
------------------------------------------------------
Text:


Zu lieblich ists, ein Wort zu brechen,
Zu schwer die wohlerkannte Pflicht...

------------------------------------------------------
Platz 1 
3x Zu

Platz 2
1x lieblich
1x ists
1x ein
1x Wort
1x brechen
1x schwer
1x die
1x wohlerkannte
1x Pflichte

---------------------------------------------------------

Sprich er listet die Vorkommnisse eines Wortes in voneinander getrennte Zellen auf. Wenn
jemand eine Idee hätte, wäre ich sehr dankbar.

MfG

[chris-ka]

Hi,

Code:

Option Explicit
Sub W?rter()
Dim strSplit() As String, var_tmp As Variant
Dim i As Long, cell_rng As Range, y As Long
Dim fAusgabe1 As Variant, fAusgabe2 As Variant
Dim rng As Range
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
For Each cell_rng In rng
    cell_rng = Replace(cell_rng, ",", "")
    cell_rng = Replace(cell_rng, "!", "")
    cell_rng = Replace(cell_rng, ".", "")
    cell_rng = Replace(cell_rng, ":", "")
    cell_rng = Replace(cell_rng, Chr(10), " ")
    For i = LBound(strSplit) To UBound(strSplit)
        Dic(strSplit(i)) = Dic(strSplit(i)) + 1
    Next i
    fAusgabe1 = Dic.Keys
    fAusgabe2 = Dic.Items
Next
    For i = LBound(fAusgabe1) To UBound(fAusgabe1) '- 1
        For y = i To UBound(fAusgabe1)
            If fAusgabe2(i) < fAusgabe2(y) Then
                var_tmp = fAusgabe2(i)
                fAusgabe2(i) = fAusgabe2(y)
                fAusgabe2(y) = var_tmp
                var_tmp = fAusgabe1(i)
                fAusgabe1(i) = fAusgabe1(y)
                fAusgabe1(y) = var_tmp
            End If
        Next y
    Next i
'top 100 bzw. bis max 100 auflisten in Spalte D
Cells(1, 4).Resize(WorksheetFunction.Min(100, UBound(fAusgabe1) + 1)) = WorksheetFunction.Transpose(fAusgabe1)
Cells(1, 5).Resize(WorksheetFunction.Min(100, UBound(fAusgabe1) + 1)) = WorksheetFunction.Transpose(fAusgabe2)
Set cell_rng = Nothing
Set rng = Nothing
Set Dic = Nothing
End Sub

ist aus
http://www.clever-excel-forum.de/Thread-...n-auslesen

nur standen da die Wörter untereinander bzw. halt mit ; (Strichpunkt) getrennt da
der obige Code würde auch für eine Zelle mit Text funktionieren. Zelle A1

[MisterBurns]

So wie ich es verstehe, steht der Text komplett in einer Zelle? Wenn ja, kannst du zB so vorgehen:

1. Zelle markieren - Reiter Daten - Datentools - Text in Spalten --> als Trennzeichen "Leerzeichen" und "Andere" auswählen. Bei "Andere" im Feld daneben mittels Alt+010 den Zeilenumbruch eingeben
2. Die Zeile markieren, kopieren und an anderer Stelle mittels "Transponieren" einfügen
3. Eine Hilfsspalte anlegen, in der neben jedem Wort der Wert 1 steht
4. Pivottabelle erzeugen mit Summe der Hilfsspalte