Welches Wort kommt am häufigsten vor /

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub WörterZählen() Dim dicErg As Object Set dicErg = CreateObject("Scripting.Dictionary") Dim txt, t txt = Selection(1).Value '--- Satzzeichen löschen For Each t In Split(", . ; ! "" ? :", " ") txt = Replace(txt, t, " ") Next '--- Wörter die mit einem Großbuchstaben anfangen zählen For Each txt In Split(WorksheetFunction.Trim(txt), " ") t = Left(txt, 1) If UCase(t) = t Then If LCase(t) UCase(t) Then dicErg(txt) = dicErg(txt) + 1 End If End If Next '--- Ergebnisausgabe If dicErg.Count > 0 Then With Selection.Offset(1, 0).Resize(dicErg.Count, 2) .Columns(1).Value = WorksheetFunction.Transpose(dicErg.Keys) .Columns(2).Value = WorksheetFunction.Transpose(dicErg.Items) End With End If End Sub

Function HäufigstesWort(txt) Dim dicErg As Object, Erg Set dicErg = CreateObject("Scripting.Dictionary") Dim t, m '--- Satzzeichen löschen For Each t In Split(", . ; ! "" ? :", " ") txt = Replace(txt, t, " ") Next '--- Wörter die mit einem Großbuchstaben anfangen zählen For Each txt In Split(WorksheetFunction.Trim(txt), " ") t = Left(txt, 1) If UCase(t) = t Then If LCase(t) UCase(t) Then dicErg(txt) = dicErg(txt) + 1 End If End If Next '--- Ergebnisausgabe If dicErg.Count > 0 Then m = WorksheetFunction.Max(dicErg.items) t = Application.Match(m, dicErg.items, 0) Erg = dicErg.keys HäufigstesWort = Erg(t - 1) & " " & m Else HäufigstesWort = "" End If End Function

Hi Werner,
schade, dass du nicht mal per Upload eine Bsp-Datei gezeigt hast.
Aber zum Glück bin von uns Beiden ja ich der Kreative(re).
Hier, versuch mal
https://www.herber.de/bbs/user/155386.xlsm
Trotz alledem kann es sein, dass der Code sehr stark an dein Original angepasst werden muss, weil meine Bsp-Texte in Spalte A so gar nicht vergleichbar sind mit deinen Texten in Spalte A.
In meiner Bsp-Datei funktionierts auf jeden Fall.
Da Daniel 2x einen ganz anderen Lösungsansatz verfolgt hat, bin ich etwas unsicher, ob ich dich denn richtig verstanden habe.
Na gut, also...
In Spalte A wird der Inhalt jeder Zeile, beginnend ab Zeile 2, überprüft, und jedes enthaltene Wort wird genau nur 1x in Spalte C eingetragen.
Wenn das geschehen ist, wird jedes Wort aus Spalte C in Spalte A gesucht - die Anzahl der Trefferhäufigkeit wird für jedes Wort in Spalte D eingetragen.
Wenn du die obige Kritik nicht verstehst, frag gern nach.
Konnte ich denn helfen, oder hab ich dich tatsächlich - nicht - verstanden?
Ciao
Thorsten

Moin zusammen,
eigentlich hatten wir schon den Stand erreicht, dass die Texte, die in Spalte A vorliegen, schon auf Worter mit Grossbuchstaben gescannt und in Spalte B Leerzeichen-getrennt vorliegen.
Daher müsste über dem Inhalt von B durchgegangen werden, um die Häufigkeit zu ermitteln.
(Basierend auf dem Werk von Daniel: dein Lesen von einem eventuell nicht vorhandenen Dictionary-Element könnte einen Fehler verursachen. )


Sub HäufigstesWort()
Dim dicErg As Dictionary
Dim RegExp As Object
Dim txt, Idx, Erg
Dim Z As Range 'Zelle
Set dicErg = CreateObject("Scripting.Dictionary")
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Pattern = "[,.;!\""?:]"
With Worksheets("Tabelle1")
'--- Wörter die mit einem Großbuchstaben anfangen zählen
For Each Z In Intersect(Range("B:B"), .UsedRange).Cells
For Each txt In Split(Application.Trim(RegExp.Replace(Z.Value, " ")), " ")
If dicErg.Exists(txt) Then
dicErg(txt) = dicErg(txt) + 1
Else
dicErg(txt) = 1
End If
Next
Next Z
'--- Ergebnisausgabe
If dicErg.Count > 0 Then
txt = WorksheetFunction.Max(dicErg.items)
Idx = Application.Match(txt, dicErg.items, 0)
Erg = dicErg.keys
HäufigstesWort = Erg(Idx - 1) & " " & txt
Else
HäufigstesWort = ""
End If
End With
End Sub

VG
Yal

Beliebteste Forumthreads (12 Monate)

Welches Wort kommt am häufigsten vor /

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread