Anzahl Wörter zählen

Hallo,
ich möchte eine umfassende Tabelle auswerten und möchte hierfür wissen, welches Wort in einer Spalte ("Überschriften" von Zeitschriften) innerhalb der Tabelle wie oft vorkommt. Hintergrund ist, dass ich aus der Anzahl der jeweils vorkommenden Wörter Rückschlüsse auf die Relevanz eines Themas ziehen möchte.
ZÄHLEWENN kenne ich, aber hierfür muss ich ja ein Suchwort vorgeben, iSv "sage mir wie oft das Wort XYZ vorkommt". Ich möchte aber sozusagen, dass Excel in einem ersten Schritt alle in der Spalte vorkommenden Wörter erfasst und mir dann sagt, welches der erfassten Wörter wie oft vorkommt.
Gibt es hierfür einen Weg, zB via Pivot? Ich war bisher leider nicht erfolgreich...
Vielen Dank!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Phi() Dim Tx As String, Ar, DD As Object Set DD = CreateObject("Scripting.Dictionary") Tx = Join(Application.Transpose(Cells(1, 1).CurrentRegion), " ") Ar = Split(Tx) For i = 0 To UBound(Ar) If DD.exists(Ar(i)) Then DD(Ar(i)) = DD(Ar(i)) + 1 Else DD(Ar(i)) = 1 End If Next i Debug.Print DD.Count Cells(1, 5).Resize(DD.Count, 2) = Application.Transpose(Array(DD.keys, DD.items)) End Sub

Sub Zählen() Dim Z1 As Integer, Sp1 As Integer, Sp2 As Integer, LR As Long Dim Arr, i As Long, j As Integer, Z As Long, WF Z1 = 7 Sp1 = 7 'Spalte G Sp2 = 10 'Spalte J Set WF = WorksheetFunction LR = Cells(Rows.Count, Sp1).End(xlUp).Row 'letzte Zeile der Spalte For i = Z1 To LR Arr = Split(Cells(i, Sp1), " ") For j = LBound(Arr) To UBound(Arr) 'Zeile ermitteln If WF.CountIf(Columns(Sp2), Arr(j)) > 0 Then 'Ist Wort schon vorhanden? Z = WF.Match(Arr(j), Columns(Sp2), 0) 'Zeile des Wortes Else Z = WF.Max(Z1, Cells(Rows.Count, Sp2).End(xlUp).Row + 1) ' noch nicht da,dann unten anfügen End If 'Wörter auflisten Cells(Z, Sp2) = Arr(j) Cells(Z, Sp2 + 1) = Cells(Z, Sp2 + 1) + 1 'Anzahl erhöhen Next Next i End Sub

Hallo nochmal
ich denke, da waren mehrere Leerzeichen mal hintereinander.


Sub Zählen()
Dim Z1 As Integer, Sp1 As Integer, Sp2 As Integer, LR As Long
Dim Arr, i As Long, j As Integer, Z As Long, WF
Z1 = 7
Sp1 = 7 'Spalte G
Sp2 = 10 'Spalte J
Set WF = WorksheetFunction
LR = Cells(Rows.Count, Sp1).End(xlUp).Row 'letzte Zeile der Spalte
For i = Z1 To LR
Arr = Split(Cells(i, Sp1), " ")
For j = LBound(Arr) To UBound(Arr)
If Trim(Arr(j))  "" Then
'Zeile ermitteln
If WF.CountIf(Columns(Sp2), Trim(Arr(j))) > 0 Then 'Ist Wort schon vorhanden?
Z = WF.Match(Trim(Arr(j)), Columns(Sp2), 0) 'Zeile des Wortes
Else
Z = WF.Max(Z1, Cells(Rows.Count, Sp2).End(xlUp).Row + 1) ' noch nicht da,dann unten anfügen
End If
'Wörter auflisten
Cells(Z, Sp2) = Arr(j)
Cells(Z, Sp2 + 1) = Cells(Z, Sp2 + 1) + 1 'Anzahl erhöhen
End If
Next
Next i
End Sub

Versuch es mal so
LG UweD

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

119 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Anzahl Wörter zählen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

119 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread