suchen und ersetzen
04.06.2009 14:35:31
Detlef
ich habe mehrere Arbeitsblätter in denen ich immer den Inhalt einer Spalte überprüfe. Dabei wird der jeweilige Inhalt der Zelle mit dem Inhalt eines KorrekturArbeitsblattes verglichen. Wird der Zellinhalt gefunden, wird er ersetzt.
Im Moment mache ich das mit folgendem tlw. aufgezeichneten Code. Das funktioniert auch. Nur habe ich den Eindruck, dass bei Abarbeitung der markierten Bereiche der Code immer langsamer läuft, Berechnung ist schon auf manuell gestellt. Hat jemand eine Idee wie man die Laufzeit optimieren könnte? Bin für jeden Hinweis dankbar.
Sub procStammnummernwechsel_2007()
On Error Resume Next
Dim STAMMNR_NEU As String
Dim STAMMNR_ALT As String
Sheets("Daten 2_Wechsler").Select
Range("rD2.Knoten").Select
STAMMNR_NEU = ActiveCell.Value 'einlesen neu Stammnummer'
STAMMNR_ALT = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value 'einlesen alte Stammnummer' _
Do While STAMMNR_NEU ""
Sheets("Import 3_Jahr2007").Select
Range("rI3.StammNummernWechselStart").Select
'Nach unten markieren
If ActiveCell.Offset(1, 0).Value "" Then
Range(Selection, Selection.End(xlDown)).Select
End If
For Each rngZelle In Selection
With Selection
.Replace What:=Val(STAMMNR_ALT), Replacement:=Val(STAMMNR_NEU), LookAt:=xlPart, _
MatchCase:=True
End With
Next rngZelle
Sheets("Daten 2_Wechsler").Select
Cells(ActiveCell.Row + 1, ActiveCell.Column).Activate
STAMMNR_NEU = ActiveCell.Value 'einlesen neu Stammnummer'
STAMMNR_ALT = Cells(ActiveCell.Row, ActiveCell.Column + 1).Value 'einlesen alte Stammnummer' _
Loop
End Sub
Gruß
Detlef