Wörter in einem Bereich zählen, VBA

Forumthread: Wörter in einem Bereich zählen, VBA

simo

hallo zusammen,
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

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

AW: Wörter in einem Bereich zählen, VBA

fcs

AW: Wörter in einem Bereich zählen, VBA

28.05.2010 00:54:26

fcs

Hallo Simo,
hier eine angepasste Version.
Die Werte für Zeile1, Spalte1, Spalte2 und lngLZ muss du ggf. ändern.
Gruß
Franz

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
Dim Bereich As Range, Zelle As Range
Dim Spalte1 As Long, Spalte2 As Long, Zeile1 As Long
'Bereich mit zu zählenden Wörtern
Spalte1 = 1 '1. Splate - Spalte A
Spalte2 = 4 'letzte Spalte - Spalte D
Zeile1 = 1 ' 1. Zeile des datenbereichs
'letzte Zeile in den Spalten
For i = Spalte1 To Spalte2
lngLZ = Application.WorksheetFunction.Max(lngLZ, _
Cells(Rows.Count, i).End(xlUp).Row)
Next i
Set Bereich = Range(Cells(Zeile1, Spalte1), Cells(lngLZ, Spalte2))
'Texte einlesen
'Dictionary erstellen und zuweisen
Set dicAlle = CreateObject("Scripting.Dictionary")
For Each Zelle In Bereich
If Not IsEmpty(Zelle) Then
'Aufteilung der Zelltexte in einzelne Array
arrVarEinzelzelle = Split(Textsäubern(Zelle.Text))
'Zuweisung der Wörter zum Dictionary
For j = 0 To UBound(arrVarEinzelzelle, 1)
dicAlle(arrVarEinzelzelle(j)) = dicAlle(arrVarEinzelzelle(j)) + 1
Next j
End If
Next Zelle
'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, ";", " ")
'doppelte Leerzeichen löschen
Do Until InStr(1, strÜbergabe, "  ") = 0
strÜbergabe = Replace(strÜbergabe, "  ", " ")
Loop
'alle Zeichen in Kleinbuchstaben wandeln
Textsäubern = Trim(LCase(strÜbergabe))
End Function

Infobox / Tutorial

Schritt-für-Schritt-Anleitung

Um die Anzahl der Wörter in einem bestimmten Bereich in Excel zu zählen, kannst Du den folgenden VBA-Code verwenden. Dieser Code wurde aus einem Forumthread abgeleitet und angepasst, um die Funktionalität auf mehrere Spalten auszudehnen.

Öffne Excel und drücke ALT + F11, um den VBA-Editor zu öffnen.
Klicke auf Einfügen und wähle Modul, um ein neues Modul zu erstellen.
Kopiere den folgenden Code in das Modul:

Sub Wörterzählen()
    Dim dicAlle As Object
    Dim arrVarAlleZellen() As Variant
    Dim arrVarEinzelzelle As Variant
    Dim lngLZ As Long, i As Long, j As Long
    Dim Bereich As Range, Zelle As Range
    Dim Spalte1 As Long, Spalte2 As Long, Zeile1 As Long

    'Bereich mit zu zählenden Wörtern
    Spalte1 = 1 '1. Spalte - Spalte A
    Spalte2 = 4 'letzte Spalte - Spalte D
    Zeile1 = 1 ' 1. Zeile des Datenbereichs

    'letzte Zeile in den Spalten
    For i = Spalte1 To Spalte2
        lngLZ = Application.WorksheetFunction.Max(lngLZ, Cells(Rows.Count, i).End(xlUp).Row)
    Next i

    Set Bereich = Range(Cells(Zeile1, Spalte1), Cells(lngLZ, Spalte2))

    'Texte einlesen
    Set dicAlle = CreateObject("Scripting.Dictionary")
    For Each Zelle In Bereich
        If Not IsEmpty(Zelle) Then
            arrVarEinzelzelle = Split(Textsäubern(Zelle.Text))
            For j = 0 To UBound(arrVarEinzelzelle, 1)
                dicAlle(arrVarEinzelzelle(j)) = dicAlle(arrVarEinzelzelle(j)) + 1
            Next j
        End If
    Next Zelle

    '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
    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, ";", " ")
    Do Until InStr(1, strÜbergabe, "  ") = 0
        strÜbergabe = Replace(strÜbergabe, "  ", " ")
    Loop
    Textsäubern = Trim(LCase(strÜbergabe))
End Function

Schließe den VBA-Editor und kehre zu Excel zurück.
Führe das Makro Wörterzählen aus, um die Wörter in dem angegebenen Bereich zu zählen.

Häufige Fehler und Lösungen

Fehler: "Kompatibilitätsproblem"
Stelle sicher, dass Du eine unterstützte Excel-Version verwendest (ab Excel 2010).
Fehler: "Ausgabe in falschen Zellen"
Überprüfe die Definition des Bereichs und die Zellen, in die die Ergebnisse geschrieben werden.
Fehler: "Makros sind deaktiviert"
Aktiviere Makros in den Excel-Optionen, um das Skript auszuführen.

Alternative Methoden

Falls Du VBA nicht verwenden möchtest, kannst Du auch Excel-Formeln in Kombination mit Hilfsspalten nutzen, um die Anzahl der Wörter zu zählen. Eine einfache Methode ist die Verwendung der Funktion ANZAHL, um die Wörter in einer Zelle zu zählen, jedoch ist dies weniger flexibel als das oben genannte VBA-Skript.

Praktische Beispiele

Beispiel 1: Zähle die Wörter in den Zellen A1:D10.
Der oben gezeigte Code zählt alle Wörter in diesem Bereich und schreibt die Ergebnisse in die Spalten F und G.
Beispiel 2: Ändere den Bereich auf A1:C20.
Ändere die Werte für Spalte1, Spalte2 und Zeile1 im VBA-Code.

Tipps für Profis

Nutze Dictionary-Objekte, um die Wörter effizient zu zählen, da sie eine schnellere Zugriffsgeschwindigkeit bieten.
Erweitere die Textsäubern-Funktion für zusätzliche Zeichen, die Du möglicherweise entfernen möchtest.
Speichere Deine Arbeitsmappe als xlsm, um die Makros zu behalten.

FAQ: Häufige Fragen

1. Kann ich den Code für andere Bereiche anpassen?
Ja, ändere einfach die Werte für Spalte1, Spalte2 und Zeile1 im Code.

2. Funktioniert dieser Code auch in Excel Online?
Leider funktioniert VBA nicht in Excel Online. Du musst die Desktop-Version verwenden.

Beliebteste Forumthreads (12 Monate)

Wörter in einem Bereich zählen, VBA

Forumthread: Wörter in einem Bereich zählen, VBA

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Wörter in einem Bereich zählen mit VBA

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread