ich habe im forum hier den unten angehängten code gefunden, welcher eine spalte nach wörtern durchsucht, sie zählt und dann ausgibt.
für meine anwendung wäre es sinnvoll, diese funktion auf einen bereich auszuweiten, bsp. A1 : D10
ich habe gerade schon eine weile herumprobiert, aber ich schaffe es leider nicht. vielleicht hat ja jemand eine schnelle idee.
vielen dank im voraus!
Sub Wörterzählen()
Dim dicAlle As Object
Dim arrZellworte As Variant
Dim arrVarAlleZellen() As Variant
Dim arrVarEinzelzelle As Variant
Dim lngLZ As Long, i As Long, j As Long
'letzte Zeile Spalte N
lngLZ = Cells(Rows.Count, 14).End(xlUp).Row
'Texte einlesen Spalte N
arrVarAlleZellen = Range(Cells(2, 14), Cells(lngLZ, 14))
'Dictionary erstellen und zuweisen
Set dicAlle = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arrVarAlleZellen)
'Aufteilung der Zelltexte in einzelne Array
arrVarEinzelzelle = Split(Textsäubern(arrVarAlleZellen(i, 1)))
'Zuweisung der Wörter zum Dictionary
For j = 0 To UBound(arrVarEinzelzelle, 1)
dicAlle(arrVarEinzelzelle(j)) = dicAlle(arrVarEinzelzelle(j)) + 1
Next j
Next i
'Ausgabe der Ergebnisse
Range("f:g").ClearContents
Range(Cells(1, 6), Cells(dicAlle.Count, 6)) = WorksheetFunction.Transpose(dicAlle.keys)
Range(Cells(1, 7), Cells(dicAlle.Count, 7)) = WorksheetFunction.Transpose(dicAlle.items)
End Sub
Function Textsäubern(ByVal strÜbergabe As String) As String
'ersetzen ungewollter Zeichen, beliebig erweiterbar
strÜbergabe = Replace(strÜbergabe, Chr(13), " ")
strÜbergabe = Replace(strÜbergabe, Chr(10), " ")
strÜbergabe = Replace(strÜbergabe, "(", " ")
strÜbergabe = Replace(strÜbergabe, ")", " ")
strÜbergabe = Replace(strÜbergabe, ",", " ")
strÜbergabe = Replace(strÜbergabe, ".", " ")
strÜbergabe = Replace(strÜbergabe, ";", " ")
'alle Zeichen in Kleinbuchstaben wandeln
Textsäubern = LCase(strÜbergabe)
End Function