Hallo allerseits,
ich habe hier vor Monaten ein Skript vorgeschlagen bekommen (s.u.), mit dem ich im Word-Dokument beliebige Begriffe zählen kann und diese Begriffe mit Anzahl der Häufigkeit ausgegeben bekomme.
Leider haben sich die Anforderungen jüngst erhöht und es handelt sich jetzt um ca. 300 Begriffe, deren Häufigkeit abgefragt werden soll. Die passen alleine schon gar nicht in das Eingabefeld der Inputbox, deswegen wollte ich hier nochmal fragen, wie ich das am geschicktesten löse. Einfach 10 Suchabfragen hintereinander durchführen? Oder geht das eleganter, indem man den "Aufnahmebereich" der Inputbox modifizieren kann?
Vielen Dank für jeden Tipp!
Veronique
Aktuelles Skript:
Sub Begriffe_suchen()
Dim a, AdC, Anzahl(), b, i, k, lMin, s(), suche, v
nocheinmal: 'Sprungadresse, falls z.B. wegen Schreibfehler eine Wiederholung erforderlich ist
suche = InputBox("Suchbegriffe mit Kommata getrennt eingeben", "Begriffe zählen", suche)
If suche = "" Then MsgBox "Kein Suchbegriff eingegeben!": Exit Sub
'Suchwörter (w()) und Anzahl (v) bestimmen:
w = Split(suche, ",")
v = UBound(w)
ReDim s(v)
lMin = Len(w(0))
For k = 0 To v
w(k) = Trim(w(k))
s(k) = LCase(w(k))
If Len(s(k)) < lMin Then lMin = Len(s(k))
Next k
lMin = lMin - 1
'Suchwörter sortieren:
For k = 0 To v - 1
For i = k + 1 To v
If s(i) < s(k) Then
a = w(i): w(i) = w(k): w(k) = a
a = s(i): s(i) = s(k): s(k) = a
End If
Next i
Next k
'Suche durchführen und Anzahl bestimmen
ReDim Anzahl(v)
For i = 0 To v
Set AdC = ActiveDocument.Content
Selection.HomeKey unit:=wdStory
Do
AdC.Find.Execute FindText:=s(i), Forward:=True
If AdC.Find.Found = True Then Anzahl(i) = Anzahl(i) + 1
Loop Until AdC.Find.Found = False
Next i
'in neues Dokument ausgeben
a = ""
For i = 0 To v
a = a + w(i) + ":" + vbTab + Str(Anzahl(i)) + vbCrLf
Next i
b = MsgBox("Folgende Begriff wurden gesucht" + vbCrLf + a + "Schreibfehler? Suche wiederholen?", vbYesNo)
If b = vbYes Then GoTo nocheinmal
Documents.Add
Selection.TypeText Text:=a
End Sub
|