Microsoft Excel

Herbers Excel/VBA-Archiv

Wörter zählen | Herbers Excel-Forum


Betrifft: Wörter zählen von: Wulf
Geschrieben am: 02.01.2010 16:23:03

Hallo,

ich habe leider ein Problem. Ich möchte in einer Spalte Wörter zählen. Diese Wörter stehen durch Komma und Leerzeichen getrennt teilweise bis zu 15 in einer Zelle. Könnt ihr mir helfen mit der zielführenden Formel?

Bisher habe ich in Foren u.a. diese Formel gefunden, die jedoch keinen Wert ergibt:
=SUMME(WENN(ISTLEER(A1:A10);0;LÄNGE(GLÄTTEN(A1:A10))-LÄNGE(WECHSELN(A1:A10;" ";""))+1))

Es geht um den Bereich N2:N319.

Über eine schnelle Antwort würde ich mich freuen.

Mfg

Wulf

  

Betrifft: AW: Wörter zählen von: Peter
Geschrieben am: 02.01.2010 16:48:00

Hallo Wulf,

probiere bitte diesen Code...(nicht von mir sondern aus dem Forum)


Option Explicit

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
'Spalte B: Wörter
Range(Cells(1, 6), Cells(dicAlle.Count, 6)) = WorksheetFunction.Transpose(dicAlle.keys)
'Spalte B: Anzahl
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
Gruß

Peter


  

Betrifft: AW: Wörter zählen von: Peter
Geschrieben am: 02.01.2010 16:48:15

Hallo Wulf,

probiere bitte diesen Code...(nicht von mir sondern aus dem Forum)


Option Explicit

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
'Spalte B: Wörter
Range(Cells(1, 6), Cells(dicAlle.Count, 6)) = WorksheetFunction.Transpose(dicAlle.keys)
'Spalte B: Anzahl
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
Gruß

Peter


  

Betrifft: Matrixformel von: Backowe
Geschrieben am: 02.01.2010 16:53:02

Hi Wulf,

die Formel muss mit STRG + Shift + Enter abgeschlossen werden:

=SUMME(WENN(ISTLEER(N2:N319);0;LÄNGE(GLÄTTEN(N2:N319))-LÄNGE(WECHSELN(N2:N319;",";""))+1))

Gruß Jürgen


  

Betrifft: AW: Matrixformel von: Wulf
Geschrieben am: 02.01.2010 17:16:14

danke, perfekt - hatte anfangs nicht geklappt - jetzt geht`s - super.


Beiträge aus den Excel-Beispielen zum Thema "Wörter zählen"