Hallo Veronique,
da hat die Software des Forums wieder zugeschlagen und Teile herausgeschnitten. Noch einmal:
pr = "Suchbegriffe mit Kommata getrennt eingeben"
Do
teilsuche = InputBox(pr, "Begriffe zählen")
teilsuche = Trim(teilsuche)
If Right(teilsuche, 1) = "," Then teilsuche = Left(teilsuche, Len(teilsuche) - 1)
If teilsuche <> "" Then
If suche <> "" Then
suche = suche + "," + teilsuche
Else
suche = teilsuche
End If
ls = 50: If Len(suche) ""
If suche = "" Then MsgBox "Kein Suchbegriff eingegeben!": Exit Sub
w = Split(suche, ",")
Ich kontrolliere gleich das Ergebnis und sende den Code ggf. noch einmal.
Gruß
Holger
Veronique schrieb am 25.11.2008 09:45:55:
Hallo Holger,
vielen Dank, dass du dich nochmal meinem Problem annimmst!
Leider marktiert mir der Editor die Zeile
ls = 50: If Len(suche) ""
rot, meckert beim Ausführen was von Syntaxfehler. Läuft das bei dir? Oder kann sich da wirklich ein kleiner Fehler eingeschlichen haben?
Veronique
Holger schrieb am 21.11.2008 15:00:07:
Hallo Veronique,
ich hatte dir damals eine InputBox zur Eingabe vorgeschlagen, weil ich davon ausging, dass du nicht in Lage sein würdest, z.B. eine UserForm zu erzeugen. Ich vermute, das bist du heute auch noch nicht. Da es aber sehr umständlich ist, diesen Vorgang in aller Kürze zu beschreiben, modifiziere ich das Makro nur hinsichtlich der Eingabe. Solange die InputBox nicht leer mit OK bestätigt wird, werden die Suchbegriffe ergänzt. Bestätigst du eine leere InputBox mit OK oder den Abbrechen-Button, fängt die Suche wie gewohnt an.
Ersetze die Zeilen
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, ",")
durch
pr = "Suchbegriffe mit Kommata getrennt eingeben"
Do
teilsuche = InputBox(pr, "Begriffe zählen")
teilsuche = Trim(teilsuche)
If Right(teilsuche, 1) = "," Then teilsuche = Left(teilsuche, Len(teilsuche) - 1)
If teilsuche <> "" Then
If suche <> "" Then
suche = suche + "," + teilsuche
Else
suche = teilsuche
End If
ls = 50: If Len(suche) ""
If suche = "" Then MsgBox "Kein Suchbegriff eingegeben!": Exit Sub
'Suchwörter (w()) und Anzahl (v) bestimmen:
w = Split(suche, ",")
Viel Erfolg
Holger
Veronique schrieb am 19.11.2008 14:57:53:
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
|