AW: Formeln automatisch durch Wert ersetzen
30.08.2013 10:49:26
fcs
Hallo Ralf,
hier entsprechende Makros, Startmakro und eigentliche Ersetzungsprozedur
Gruß
Franz
'Beispiel zum Starten des Ersetzungsmakros
Public Sub Formel_zu_Wert_EA()
If MsgBox("In Spalte E für Datumsbereich in ""E1"" und ""E2"" die Formeln " _
& "durch Werte ersetzen", _
vbQuestion + vbOKCancel, "F O R M E L N E R S E T Z E N") = vbOK Then
With ActiveSheet
Call fncFormel_zu_Wert(SpalteFormel:=5, SpalteVergleich:=1, _
varMin:=.Range("E1"), varMax:=.Range("E2"), Zeile_1:=4)
End With
End If
End Sub
'Code in einem allgemeinen Modul
Public Function fncFormel_zu_Wert(SpalteFormel As Long, SpalteVergleich As Long, _
varMin, varMax, Optional Zeile_1 As Long = 2, _
Optional wks As Worksheet) As Boolean
' Formeln in einer Spalte durch Werte ersetzen, abhängig von Wertebereich _
in anderer Spalte
' SpalteFormel = Spalte mit Formel
' SpalteVergleich = Spalte mit Vergleichswert
' varMin = untere Grenze für Vergleich
' varMax = obere Grenze für Vergleich
' Zeile_1 = Zeile ab der Vergleich starten soll - Vorgabe = 2
' wks = Tabellenblatt in dem Ersetz werden soll - Vorgabe = aktives Blatt
Dim varWert
Dim lngZeile As Long, StatusCalc As Long
On Error GoTo Fehler
If varMin > varMax Then
MsgBox "Der obere Vergleichswert ist kleiner als der untere Vergleichswert!", _
vbInformation + vbOKOnly, "Makro: prcFormel_zu_Wert"
fncFormel_zu_Wert = False
Exit Function
End If
If wks Is Nothing Then Set wks = ActiveSheet
With wks
.Columns(SpalteFormel).Calculate 'Spalte mit Formeln neu berechnen
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
'Zeilen in Spalte mit Formeln abarbeiten
For lngZeile = Zeile_1 To .Cells(.Rows.Count, SpalteFormel).End(xlUp).Row
varWert = .Cells(lngZeile, SpalteVergleich).Value
If varWert >= varMin And varWert