AW: suche-ersetze
07.07.2003 14:16:38
th.heinrich
hallo Dat,
und hier noch einer, dabei werden auch die geaenderten zellen markiert.
Sub SuchenErsetzen()
Dim db As Range
Dim Sht As Worksheet
Dim strTitle, strSearch As String
Dim strMsgSearchEmpty, strMsgConfirm As String
Dim strMsgEqual, strReplace As String
Dim Suche, Ersetze, varResponce As Variant
' Titel und Text für Msg-Boxen
strTitle = "Suchen und Ersetzen... GLOBAL"
strSearch = "Suche nach ?"
strMsgSearchEmpty = "Kein Kriterium zum Suchen eingegeben!"
strMsgEqual = "Die Werte fuer Suchen und Ersetzen sind identisch!"
strMsgConfirm = vbNullString
strReplace = vbNullString
'Such-String
Suche = Application.InputBox(strSearch, strTitle, Type:=11)
If Suche = False Then Exit
Sub 'Abbrechen gewählt
If Len(Suche) > 0 Then
strReplace = "Ersetze " & vbTab & Suche & vbCrLf & "mit:"
Ersetze = Application.InputBox(strReplace, strTitle, Type:=11)
If Ersetze = False Then Exit
Sub 'Abbrechen gewählt
Else
MsgBox strMsgSearchEmpty, vbExclamation, strTitle
Exit Sub
End If
If Suche <> Ersetze Then
strMsgConfirm = "ACHTUNG, UNDO NICHT moeglich!" & vbCrLf & vbCrLf & _
"Bitte bestaetigen Sie: " & vbCrLf & "Suchen nach:" & vbTab & Suche & _
vbCrLf & "Ersetzen mit:" & vbTab & Ersetze
varResponce = MsgBox(strMsgConfirm, vbYesNo + vbQuestion + vbDefaultButton2, strTitle)
If varResponce = vbYes Then
' Der zu durchsuchende Bereich wird festgelegt, um die Geschwindigkeit zu erhöhen
Set db = Worksheets("Tabelle1").Range("A1:T200")
For Each Zelle In db
With Zelle
If .Value <> vbNullString And InStr(.Value, Suche) <> 0 Then
.Replace What:=Suche, Replacement:=Ersetze, _
LookAt:=xlPart, MatchCase:=False
.Activate
.Interior.ColorIndex = 6
End If
End With
Next Zelle
Else
MsgBox strMsgEqual, vbExclamation, strTitle
End If
End If
End Sub
' von GraFri
gruss thomas