Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1448to1452
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Excel Wörterbuch: in Word-Datei suchen und zählen

Excel Wörterbuch: in Word-Datei suchen und zählen
25.09.2015 16:07:24
Dylan
Hallo liebe Excel-Freunde,
für eine Inhaltsanalyse möchte ich ein Worddokument mithilfe eines Excel-Wörterbuchs durchsuchen, die Treffer einfärben, zählen und den jeweiligen Fundort samt Trefferanzahl je Wort in das Excel-Wörterbuch schreiben, bspw. in Spalte B und C.
Bisher ist es mir mithilfe diverser Codeschnipsel und Anpassungen nur gelungen, die Treffer einzufärben und zu zählen, siehe hierzu unten stehender Code. Vor allem dauert das Ausführen des Skriptes bei meinem 4000-Seiten-Dokument fast eine Viertelstunde... ist das normal?
Könnt ihr mir bitte weiterhelfen?
Vielen Dank!
Sub KEYWORDS_SUCHEN_UND_ZAEHLEN()
' KEYWORDS SUCHEN
' UND FARBIG HERVORHEBEN
Dim myRange As Range, AktWord As Variant
Dim AllWord() As String, iWord As Long, Found As Boolean
Dim TmpStr As String
Set myRange = ActiveDocument.Range
' Exceldaten aus offener Arbeitsmappe einlesen
' Aktuell: 1. Spalte Zeile 1-200
Dim xlApp As Object ' Excel.Application
Dim SuchRange As Object, AktZelle As Object
Set xlApp = GetObject(, "Excel.Application")
Set SuchRange = xlApp.Range("A1:A200")
With SuchRange
For Each AktZelle In SuchRange
If Len(AktZelle & "") > 0 Then
ReDim Preserve AllWord(iWord)
AllWord(iWord) = UCase(AktZelle)
iWord = iWord + 1
End If
Next
End With
' Worddokument durchsuchen und Wörter Rot färben
Set myRange = ActiveDocument.Range
With myRange
For Each AktWord In .Words
TmpStr = Trim(AktWord.Text)
For iWord = 0 To UBound(AllWord)
If UCase(TmpStr) Like AllWord(iWord) & "*" Then
AktWord.Font.Color = wdColorRed
End If
Next
Next
End With
Set SuchRange = Nothing
Set myRange = Nothing
' FARBIG HERVORGEHOBENE
' KEYWORDS ZÄHLEN
Dim highlightCount
highlightCount = 0
For Each w In ActiveDocument.Words
If w.Font.Color = wdColorRed Then
'w.Delete
highlightCount = highlightCount + 1
End If
Next
MsgBox ("Das Dokument enthält " & highlightCount & " Übereinstimmungen mit dem Wörterbuch.")
End Sub

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel Wörterbuch: in Word-Datei suchen und zählen
25.09.2015 17:49:54
Sepp
Hallo Dylan,
teste mal.
Sub KEYWORDS_SUCHEN_UND_ZAEHLEN()
  '
  ' KEYWORDS SUCHEN
  ' UND FARBIG HERVORHEBEN
  '
  Dim myRange As Range, AktWord As Variant
  Dim objArrayList As Object, vntList As Variant
  Dim xlApp As Object ' Excel.Application
  Dim lngR As Long, lngC As Long, lngCount As Long
  
  Set myRange = ActiveDocument.Range
  Set xlApp = GetObject(, "Excel.Application")
  Set objArrayList = CreateObject("System.Collections.Arraylist")
  '
  ' Exceldaten aus offener Arbeitsmappe einlesen
  ' Aktuell: 1. Spalte Zeile 1-200
  '
  vntList = xlApp.Range("A1:A200")
  
  With objArrayList
    For lngR = LBound(vntList, 1) To UBound(vntList, 1)
      For lngC = LBound(vntList, 2) To UBound(vntList, 2)
        If Trim(vntList(lngR, lngC)) <> "" Then
          If Not .Contains(Trim(LCase(vntList(lngR, lngC)))) Then
            If vntList(lngR, lngC) <> "" Then .Add Trim(LCase(vntList(lngR, lngC)))
          End If
        End If
      Next
    Next
  End With
  
  '
  ' Worddokument durchsuchen und Wörter Rot färben
  '
  
  With myRange
    For Each AktWord In .Words
      If objArrayList.Contains(Trim(LCase(AktWord.Text))) Then
        AktWord.Font.Color = wdColorRed
        lngCount = lngCount + 1
      End If
    Next
  End With
  
  MsgBox ("Das Dokument enthält " & lngCount & " Übereinstimmungen mit dem Wörterbuch.")
  
  Set objArrayList = Nothing
  Set xlApp = Nothing
  Set myRange = Nothing
End Sub


Gruß Sepp

Anzeige
AW: Excel Wörterbuch: in Word-Datei suchen und zählen
27.09.2015 15:38:27
Dylan
Lieber Sepp,
vielen Dank für Deine schnelle Antwort!
Allerdings liefert Dein Skript exakt das gleiche Ergebnis zur gleichen Geschwindigkeit wie mein Skript.
Welche Funktion noch fehlt (siehe oben):
- jeweiligen Fundort samt Trefferanzahl je Wort in das Excel-Wörterbuch schreiben, bspw. in Spalte B und C
Herzliche Grüße,
Dylan

AW: Excel Wörterbuch: in Word-Datei suchen und zählen
28.09.2015 13:24:18
Born
Hallo Dylan,
um es etwas schneller auszuführen, kannst Du noch am Start des Makros
ScreenUpdating, EnableEvents und DisplayAlerts auf False setzen sowie den Calculationmodus auf Manuell. Am Ende des Makros setzt Du alles wieder zurück.
Viele Grüße,
M. Born

Anzeige
AW: Excel Wörterbuch: in Word-Datei suchen und zählen
28.09.2015 19:38:50
Dylan
Lieber M. Born,
auch Dir vielen Dank für Deine schnelle Nachricht!
ScreenUpdating und DisplayAlerts funktionieren (ich arbeite in Word und führe dort auch das Makro aus), EnableEvents und Calculation leider nicht. Dies hat daher die Laufzeit leider entsprechend wenig verkürzt.
Die Wartezeit nehme ich ja in Kauf, wenn meine übrigen und deutlich wichtigeren Probleme beseitigt sind (wie bereits geschildert):
- Trefferanzahl pro Wort aus dem Wörterbuch in die Spalte B des Excel-Wörterbuchs schreiben
- Fundort (Seite) pro Wort aus dem Wörterbuch in die Spalte C des Excel-Wörterbuchs schreiben
Ich komme da leider überhaupt nicht weiter :(
Herzliche Grüße,
Dylan

Anzeige
AW: Excel Wörterbuch: in Word-Datei suchen und zählen
29.09.2015 17:47:01
Dylan
Kann mir denn niemand mit dem Problem hier helfen?

leicht angepaßt
29.09.2015 18:21:07
Michael
Hi zusammen,
ich habe Sepps Code etwas umgestellt:
a) kenne ich mich mit der arraylist nicht aus, und bevor ich lange herumsuche, habe ich dictionary verwendet
b) da werden die gefundenen Wörter der Spalte A (ohne etwaige Doppelte) als "key" gespeichert und als "item" die Zeilennr.
c) als Array werden die Spalten A-C eingelesen, wobei B & C gleich geleert werden
d) wenn ein Wort im Dictionary gefunden wurde, wird die Anzahl im Array/Spalte B erhöht, in Spalte C wird die Spalte/Zeile des Word-Docs geschrieben.
e) das ganze Array wird in Excel zurückgeschrieben.
Teste mal:
Option Explicit
Sub KEYWORDS_SUCHEN_UND_ZAEHLEN_DIC()
' KEYWORDS SUCHEN
' UND FARBIG HERVORHEBEN
Dim myRange As Range, AktWord As Variant
Dim objArrayList As Object, vntList As Variant
Dim xlApp As Object ' Excel.Application
Dim lngR As Long, lngC As Long, lngCount As Long
Dim begriff As String
Set myRange = ActiveDocument.Range
Set xlApp = GetObject(, "Excel.Application")
'Set objArrayList = CreateObject("System.Collections.Arraylist")
Set objArrayList = CreateObject("scripting.dictionary")
' Exceldaten aus offener Arbeitsmappe einlesen
' Aktuell: 1. Spalte Zeile 1-200
vntList = xlApp.Range("A1:C200")
' Spalte B auf 0 setzen, Spalte C = Leerstring
For lngR = LBound(vntList, 1) To UBound(vntList, 1)
If vntList(lngR, 1)  "" Then _
objArrayList(Trim(LTrim(LCase(vntList(lngR, 1))))) = lngR
vntList(lngR, 2) = 0
vntList(lngR, 3) = ""
Next
' Worddokument durchsuchen und Wörter Rot färben
With myRange
For Each AktWord In .Words
begriff = Trim(LTrim(LCase(AktWord.Text)))
If objArrayList.Exists(begriff) Then
AktWord.Font.Color = wdColorRed
lngR = objArrayList.Item(begriff)
vntList(lngR, 2) = vntList(lngR, 2) + 1
vntList(lngR, 3) = vntList(lngR, 3) & "s" & _
AktWord.Information(wdFirstCharacterColumnNumber) & _
"r" & AktWord.Information(wdFirstCharacterLineNumber) & ";"
lngCount = lngCount + 1
End If
Next
End With
xlApp.Range("A1:C200") = vntList
MsgBox ("Das Dokument enthält " & lngCount & " Übereinstimmungen mit dem Wörterbuch.")
Set objArrayList = Nothing
Set xlApp = Nothing
Set myRange = Nothing
End Sub
Schöne Grüße,
Michael
P.S.: Sehr schöne Blindtexte gibt es übrigens bei http://bavaria-ipsum.de/
Das erste Wort zum Testen war natürlich "Maß", denn man Prost!

Anzeige
AW: leicht angepaßt
29.09.2015 23:33:24
Dylan
Vielen lieben Dank, Michael!
Nachdem gestern mein Rechner den Geist aufgegeben hat, muss ich jetzt alles auf dem Surface testen :(
Das Skript sucht jetzt fleißig nach den Wörtern im Wörterbuch, markiert die Treffer im Worddokument und gibt entsprechende Trefferzahlen und -orte je Wort in Excel aus.
Allerdings scheint etwas mit den Daten in Excel nicht zu stimmen: Wenn ich stichprobenartig in Word nach ein paar Wörtern suche, werden auf diese Weise oft mehr Treffer gefunden als Excel in der Spalte B als Zahl ausgibt. Könnte das daran liegen, dass die herkömmliche Word-Suche automatisch mit Wildcard sucht und Excel nicht? Wenn ich bspw. nach "AKW" über die Suchmaske suche, finde ich Wörter wie "AKW", "AKW-Betreiber" und "AKWs". Excel findet allerdings nur die ersten beiden und ignoriert den letzten.
Darüber hinaus verstehe ich den Fundort in Spalte C nicht ganz: Werden dort nun die jeweiligen Fundstellen der Wörter aus dem in Excel hineingeladenen Array angegeben? Ich brauche nämlich lediglich die Seitenangabe der jeweiligen Fundstelle im Worddokument...
Nochmals Danke für Deine Mühe und herzliche Grüße,
Dylan

Anzeige
Salamitaktik
30.09.2015 16:47:40
Michael
Hi Dylan,
Du führst uns hier ein schönes Beispiel von Salamitaktik vor: sobald was tut, fällt Dir ein, daß es eigentlich was anderes tun soll. Zur Verdeutlichung: nachdem ich mit Word-VBA völlig unbeleckt bin, habe ich gestern erst mal 1 1/2 h recherchiert, wie man die Zeile ermittelt, und jetzt sagst Du, daß Du sie gar nicht willst: wenn Du die Seiten-Nr. haben willst, sieh Dir die Parameter von AktWord.Information an, da wirst Du sicher fündig.
Jetzt kriegst Du es natürlich ab, stellvertretend für viele andere, mach Dir nix draus. Aber: es wäre einfacher, wenn man gleich *alles* wüßte.
Die Word-Schleife läuft alle Wörter der Reihe nach durch: myRange ist der komplette Text, von dem jeweils eines nach dem anderen, nämlich AktWord betrachtet wird.
Ich habe gestern aufgeschnappt, daß Satzzeichen von Word als "eigenständige" Objekte interpretiert werden: das erklärt, warum AKW-Betreiber gefunden wird: dabei werden nämlich *drei* "Wörter" verglichen: "AKW", "-" und "Betreiber".
Eine Wildcard-Suche (akw*) ist im Dictionary nicht direkt verfügbar,
http://stackoverflow.com/questions/28246074/wildcard-search-of-dictionary
so daß man prinzipiell alle Wörter in einer Schleife durchgehen muß (das ist der Schnipsel ganz unten).
Klingt zeitaufwendig und nach komplett falschem Ansatz.
Der richtige wäre wahrscheinlich (mal ins Blaue gesagt), nicht alle einzelnen Wörter des Textes durchzulaufen, sondern die von Excel übernommenen Werte der Reihe in Words Suchfunktion zu übernehmen und von dort aus die Trefferausgabe zu steuern.
Ich habe jetzt trotzdem aus reiner Faulheit die "falsche" Variante entsprechend erweitert:
Option Explicit
Sub KEYWORDS_SUCHEN_UND_ZAEHLEN_DIC_Wild()
Dim myRange As Range, AktWord As Variant, AktKey As Variant
Dim objArrayList As Object, vntList As Variant
Dim xlApp As Object ' Excel.Application
Dim lngR As Long, lngC As Long, lngCount As Long
Dim begriff As String
Dim gefunden As Boolean
Set myRange = ActiveDocument.Range
Set xlApp = GetObject(, "Excel.Application")
Set objArrayList = CreateObject("scripting.dictionary")
vntList = xlApp.Range("A1:C200")
' Spalte B auf 0 setzen, Spalte C = Leerstring
For lngR = LBound(vntList, 1) To UBound(vntList, 1)
If vntList(lngR, 1)  "" Then _
objArrayList(Trim(LTrim(LCase(vntList(lngR, 1))))) = lngR
vntList(lngR, 2) = 0
vntList(lngR, 3) = ""
Next
' Worddokument durchsuchen und Wörter Rot färben
With myRange
For Each AktWord In .Words
begriff = Trim(LTrim(LCase(AktWord.Text)))
For Each AktKey In objArrayList.keys
If begriff Like "*" & AktKey & "*" Then
AktWord.Font.Color = wdColorRed
lngR = objArrayList.Item(AktKey)
vntList(lngR, 2) = vntList(lngR, 2) + 1
vntList(lngR, 3) = vntList(lngR, 3) & _
"s" & AktWord.Information(wdFirstCharacterColumnNumber) & _
"r" & AktWord.Information(wdFirstCharacterLineNumber) & _
"S" & AktWord.Information(wdActiveEndPageNumber) & ";"
' ********** s=spalte, r=zeile,S=Seite *******************
lngCount = lngCount + 1
Exit For
End If
Next
Next
End With
xlApp.Range("A1:C200") = vntList
MsgBox ("Das Dokument enthält " & lngCount & " Übereinstimmungen mit dem Wörterbuch.")
Set objArrayList = Nothing
Set xlApp = Nothing
Set myRange = Nothing
End Sub

Die braucht bei 1450 Wörtern und 16 Suchbegriffen schon ein paar Sekunden. Spiel halt mal damit herum, ob Du dem Code vertraust, und wenn ja, wirf ihn an und geh mit dem Hund spazieren...
Schöne Grüße,
Michael

Anzeige
AW: Salamitaktik
30.09.2015 20:23:03
Dylan
Lieber Michael,
herzlichen Dank für die Zeit und Mühe, die Du investiert hast.
Ich weiß Dein Engagement sehr zu schätzen!
Außerdem verstehe ich, dass es nervig ist, wenn immer wieder neue und andere Aspekte erfragt werden; im Hinblick auf die Validität der Daten (Thema Wildcard) hast Du auch vollkommen Recht. Das ist mir leider erst beim Ausprobieren aufgefallen. Allerdings muss ich zu meiner "Verteidigung" sagen, dass bspw. hinsichtlich des Fundorts meinerseits nie die Rede von Zeilen und Spalten, sondern ausschließlich von Seiten war (siehe mein Post vom 28.9.).
Wie dem auch sei: Dein Code funktioniert genau so, wie ich es mir gewünscht habe und selbst nicht hinbekommen hätte. Nochmals vielen Dank!
Womit kann ich Dir denn eine Freude machen bzw. in welcher Form kann ich mich bei Dir revanchieren?
Herzliche Grüße und einen schönen Abend,
Dylan

Anzeige
Alles gut
01.10.2015 14:55:49
Michael
Lieber Dylan,
das mit den Seitenzahlen habe ich übersehen, entschuldigung, daß ich deshalb gemeckert habe.
Aber vielleicht war's ganz gut so, irgendwie mußte ich ja dieses ".Information" finden, und wenn man das mal hat, ist es nicht mehr schwierig, das eine (Zeilen) oder andere (Seiten) zu ermitteln.
Es hat mich interessiert, Deine Aufgabe zu bearbeiten, gerade weil ich von Word VBA keinen Schimmer habe: es ging ja nur darum, Sepps vorhandenen Code-Schnipsel anzupassen.
Insbesondere wollte ich schon sein einiger Zeit mal Wörter in einem Text zählen. Das konnte ich jetzt easy aus der vorhandenen Lösung ableiten:
Sub Woerter_Zaehlen()
Dim myRange As Range, AktWord As Variant, AktKey As Variant
Dim objArrayList As Object, vntList As Variant
Dim xlApp As Object ' Excel.Application
Dim lngR As Long, lngC As Long, lngCount As Long
Dim begriff As String
Dim gefunden As Boolean
Dim t1 As Single, t2 As Single
Set myRange = ActiveDocument.Range
Set xlApp = GetObject(, "Excel.Application")
Set objArrayList = CreateObject("scripting.dictionary")
t1 = Timer
vntList = xlApp.Range("A1:B200")
With myRange
For Each AktWord In .Words
begriff = Trim(LTrim(LCase(AktWord.Text)))
' ********************** Variante 1: nur zählen ********************
'      If objArrayList.Exists(begriff) Then
'         objArrayList.Item(begriff) = objArrayList.Item(begriff) + 1
'        Else
'         objArrayList(begriff) = 1
'      End If
' ********** benötigt nur wenige Sekunden **************************
' ********************** Variante 2: mit Seitenzahlen **************
If objArrayList.Exists(begriff) Then
objArrayList.Item(begriff) = objArrayList.Item(begriff) & _
"S" & AktWord.Information(wdActiveEndPageNumber)
Else
objArrayList(begriff) = "S" & _
AktWord.Information(wdActiveEndPageNumber)
End If
' *********** benötigt die ca. 20-fache Zeit ***********************
Next
End With
lngR = 1
lngCount = objArrayList.Count
ReDim vntList(1 To lngCount + 1, 1 To 2)
For Each AktKey In objArrayList.keys
vntList(lngR, 1) = AktKey
vntList(lngR, 2) = objArrayList.Item(AktKey)
lngR = lngR + 1
Next
' zeit ans Array anhängen
t2 = Timer
vntList(lngCount + 1, 1) = t1
vntList(lngCount + 1, 2) = t2
' ********************** Variante 1: nur zählen ********************
'  xlApp.Range("A1:B" & lngCount + 1) = vntList
' ********************** Variante 2: mit Seitenzahlen **************
xlApp.Range("E1:F" & lngCount + 1) = vntList
MsgBox "t1: " & t1 & " t2: " & t2
Set objArrayList = Nothing
Set xlApp = Nothing
Set myRange = Nothing
End Sub

Eine Rotfärbung ist hier natürlich sinnlos.
Das "der" ist im geprüften Text mit 9000 Wörtern am häufigsten, dicht gefolgt von "und" und "die", außerdem kann man bei der Ausgabe schön nachvollziehen, wie Word-VBA arbeitet: massenweise Leerzeichen und alle Sonderzeichen werden getrennt erfaßt bzw. ausgegeben.
Also haben wir die typische win-win-Situation: durch die Lösung Deines Problems hat sich auch meines gelöst.
Dank auch an Sepp für die Vorarbeit.
Herzliche Grüße aus Nürnberg,
Michael

Anzeige
AW: Alles gut
01.10.2015 17:15:37
Dylan
Das freut mich sehr! :)
Dein Wörterzählcode sieht übrigens interessant aus. Gab es dazu einen bestimmten Anlass oder einfach nur das Interesse, ob und wie so etwas funktioniert? Der Ansatz ist nämlich für eine quantitative Inhaltsanalyse sehr hilfreich!
Ich bin auf jeden Fall als Nicht-Programmierer ziemlich stolz, dass ich nicht mit leeren Händen hier ins Forum gekommen bin und ich Dich (und Sepp) mit meiner Problemstellung begeistern konnte.
Herzliche Grüße aus dem Tal der Wupper und frohes Coden,
Dylan

AW: Alles gut
03.10.2015 15:20:22
Michael
Hallo Dylan,
wie sag ich's Dir möglichst kurz?
Mir ging es darum, daß die Verschlüsselung eines Textes mit einem zufälligen Schlüssel, der im Prinzip genauso lang ist wie der Text, und mit dem letzterer XORiert wird, als sicher gilt, und zwar unter der Voraussetzung, daß nie mehrmals der gleiche Schlüssel verwendet wird: https://de.wikipedia.org/wiki/One-Time-Pad
Ansonsten *könnte* man aus zwei verschiedenen Texten den Schlüssel wieder extrahieren: dazu verwendet man nämlich die Wörter, die in der jeweiligen Sprache am häufigsten vorkommen (das schrittweise Verfahren habe ich bislang im Internet nicht so recht beispielhaft beschrieben gefunden, erst im Anhang von https://de.wikipedia.org/wiki/Geheime_Botschaften). Welche das in der jeweiligen Sprache sind, ist mehr oder weniger bekannt, aber ich wollte einfach mal einen "eigenen" Text analysieren.
Ich habe den Schnipsel nicht zuletzt deshalb hochgeladen, weil er evtl. auch für Dich tauglich wäre, falls Du auf die Einfärbung verzichten könntest: anschließend könnte man Dein vorhandenes Wörterbuch mit der Liste der gefundenen/gezählten Wörter vergleichen, was wahrscheinlich insgesamt schneller ist als die verschachtelten Schleifen - aber Du wirst ja nicht laufend 4000-seitenweise Texte vergleichen wollen.
Happy Exceling,
Michael
Anzeige

327 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige