|
Danke Gast
Ich habe einen Script gefunden, den ich etwas angepasst habe und der auch supper funktioniert - bis auf den Zähler
Wenn ich den Zähler laufen lasse, wird zwar die korrekte Anzahl "Ersetzt" angegeben, aber nur die letzte "Fundstelle" geändert
Wenn ich die "Do While"-Schlaufe auskommentiere, dann werden alle Fundstellen ersetzt.
Wo liegt denn da der Schatz im Keller?
Sub SU_FindAndReplaceMultiItems()
Dim j%, sMsg$, sOut$, xA, xB, xAnz
sMsg = "SU_FindAndReplaceMultiTems( )" & vbLf & vbLf
Application.ScreenUpdating = False
xA = Split("Text;Neu_Kurt;Otto", "_") 'Suchen ersetzen "Text" wird "Neu", "Kurt" wird "Otto"
ReDim xAnz(UBound(xA))
For j = 0 To UBound(xA)
xB = Split(xA(j), ";") 'xB(0) = suchen, xB(1) = ersetzen
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = xB(0)
.Replacement.Text = xB(1)
.Format = False
.MatchWholeWord = False
' Do While .Execute '!!!!!!!!!!
' xAnz(j) = xAnz(j) + 1
' Loop
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Application.ScreenUpdating = True
' -----------------------------------------------------------------------------------------
'Treffer zählen und ausgeben
For j = 0 To UBound(xAnz)
If Val(xAnz(j)) > 0 Then
xB = Split(xA(j), ";")
sOut = sOut & xAnz(j) & "x " & xB(0) & " > " & xB(1) & vbLf
End If
Next j
If Trim(sOut) <> "" Then MsgBox sMsg & "es wurden ersetzt:" & vbLf & sOut, vbInformation
End Sub
mfg Pepi
|