AW: Makro zum Ersetzen von Werten
26.05.2011 04:05:57
Werten
Hallo Martin,
hier mein Vorschlag. Es wird nicht die Suchen/Ersetzen-Funktion verwendet, sonder der Inhalt der einzelnen Zellen geprüft und ggf. ersetzt. So kann man das Ersetzen etwas feiner steuern.
Während des Ersetzens dürfen die Verknüpften Dateien nicht geöffnet sein, da sonst die Pfadangabe in den Formeln fehlt und ggf. Problem auftreten.
Fall vor der Jahreszahl in den Formeln immer ein Leerzeichen steht, dann kannst du den Such-/Ersetztstring entsprechend anpassen. Formeln mit Zeilennummern größer oder gleich Jahr sind dann kein Problem mehr und du kannst das Ersetzen auf alle gewünschten Blätter ausdehnen.
Gruß
Franz
Sub Jahr_in_Formeln_ersetzen()
'Ersetzt das Jahr in Formeln und Texten
Dim wks As Worksheet, sJahrAlt, sJahrNeu, Zelle As Range
Dim StatusCalc As Long
On Error GoTo Fehler
With Worksheets("Tabelle2") 'Blattname ggf. anpassen
sJahrAlt = .Range("F43").Text
' sJahrAlt = " " & .Range("F43").Text 'Verwenden, wenn vor der Jahreszahl in den _
Formeln immer ein Leerzeichen steht
sJahrNeu = .Range("D43").Text
' sJahrNeu = " " & .Range("D43").Text 'Verwenden, wenn vor der Jahreszahl in den _
Formeln immer ein Leerzeichen steht
End With
'Makrobremsen lösen
With Application
.EnableEvents = False
StatusCalc = .Application.Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Makro ""Jahr_in_Formeln_ersetzen"" wird zurZeit ausgeführt"
End With
For Each wks In ActiveWorkbook.Worksheets
Select Case wks.Name
Case "Tabelle2", "Fragebögen", "Teilnehmer", "Datenblatt"
'Nicht ersetzen - Blattnamen ggf. anpassen/ergänzen
Case Else
Application.DisplayAlerts = False
For Each Zelle In wks.UsedRange
If Zelle.HasFormula = True Then
'Zelle enthält eine Formel
Zelle.Formula = Replace(Zelle.Formula, Find:=sJahrAlt, Replace:=sJahrNeu)
ElseIf IsNumeric(Zelle) Then
'Zellwert ist nummerisch - do nothing
ElseIf IsDate(Zelle) Then
'Zellwert ist Datum - do nothing
Else
'Zelle enthält Text
Zelle.Value = Replace(Zelle.Value, Find:=sJahrAlt, Replace:=sJahrNeu)
End If
Next
Application.DisplayAlerts = True
End Select
Next
MsgBox "Fertig!", vbInformation + vbOKOnly, "Jahr ersetzen"
'Fehlerbehandlung
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'kein Fehler
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
.StatusBar = False
End With
'Variablen aufräumen
Set wks = Nothing: Set Zelle = Nothing 'Objektvariablen zurücksetzen
End Sub