Hi Nike,
das Problem besteht sobald ich für den Parameter "QH" einen berechneten Wert aus einem Sheet eingebe. Ich habe jetzt festgestellt, daß das Problem nicht bei "Application.EnabledEvents" besteht. Habe die entsprechenden Codes mal beigefügt. Das Markro "Worksheet_Change" funktioniert dann nicht mehr.
Gruß Markus
Code in Modul1
Public Function AnlEP(ANL As String, AN As Single, QH As Single) As Single
'An = beheizte Nutzfläche in [m²]
'QH = flächenbezogener Heizwärmebedarf [kWh/m²a]
Dim a As Integer 'nächstniedriger Wert für AN
Dim b As Integer 'nächsthöherer Wert für AN
Dim c As Single 'nächstniedriger für QH
Dim d As Single 'nächsthöherer für QH
Dim e As String 'Namen für Tabellenbereich ermitteln
Dim f As Single 'nächstniedriger Wert für EP-Zahl
Dim g As Single 'nächsthöherer Wert für EP-Zahl
Dim Bereich As Object 'Bereich der Tabelle
Dim x As Byte 'Spalte ermitteln
Dim y As Byte 'Zeilenzahl ermitteln
'Parameterfehler abfangen
If AN > 10000 Then AN = 10000
If AN < 100 Then AN = 100
e = "Anl" & (Right(ANL, 2))
'Tabellenbereich markieren und "nächstniedrigere" Zeile/Spalte ermitteln
With Application.WorksheetFunction
Set Bereich = ThisWorkbook.Worksheets("Datengrundlage").Range(e)
x = .HLookup(AN, Bereich, 2, True) + 2 'Spaltenzahl
If QH >= 90 Then
y = 7
QH = 90
Else
y = .VLookup(QH, Bereich, 2, True) + 2 'Zeilenzahl
End If
With Bereich
If IsEmpty(.Cells(y, x).Value) = False And IsEmpty(.Cells(y, x + 1).Value) = True Then
x = x - 1
AN = .Cells(1, x + 1).Value
ElseIf IsEmpty(.Cells(y, x).Value) = True Then
Do Until IsEmpty(.Cells(y, x).Value) = False
x = x - 1
Loop
x = x - 1
AN = .Cells(1, x + 1).Value
End If
a = .Cells(1, x).Value 'nächstniedriger Wert für AN
b = .Cells(1, x + 1).Value 'nächsthöherer Wert für AN
c = .Cells(y, x).Value 'nächstniedriger Zahlenwert für Ep_tmp
d = .Cells(y, x + 1).Value 'nächsthöherer Zahlenwert für Ep_tmp
End With
f = .Round(Interpolation(AN, a, b, c, d), 2)
'EP-Zahl für nächsthöheren AN-Wert
'Tabellenwerte für Interpolation ermitteln
y = y + 1
With Bereich
c = .Cells(y, x).Value 'nächstniedriger Zeilenwert für QH
d = .Cells(y, x + 1).Value 'nächsthöherer Zeilenwert für QH
End With
g = .Round(Interpolation(AN, a, b, c, d), 2)
'Ermittelten Werte interpolieren und Endergebnis auswerfen
AnlEP = .Round(Interpolation(QH, Bereich.Cells(y - 1, 1).Value, Bereich.Cells(y, 1).Value, f, g), 2)
End With
End Function
Private Function Interpolation(e, a, b, c, d)
'E = Eingangswert
'a = nächstniedrigere Eingangswert
'b = nächsthöhere Eingangswert
'c = Ergebnis entsprechend a
'd = Ergebnis entsprechend b
Interpolation = c + ((e - a) * (d - c) / (b - a))
End Function
Code in einem Sheet,
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Ende
If Target.Address = "$D$15" Then
Application.EnableEvents = False
If Range("D15").Value <> "" Then
Range("D17").Value = ""
Range("D19").Value = ""
End If
Application.EnableEvents = True
ElseIf Target.Address = "$D$17" Then
Application.EnableEvents = False
If Range("D17").Value <> "" Then
Range("D15").Value = ""
Range("D19").Value = ""
End If
Application.EnableEvents = True
ElseIf Target.Address = "$D$19" Then
Application.EnableEvents = False
If Range("D19").Value <> "" Then
Range("D15").Value = ""
Range("D17").Value = ""
End If
Application.EnableEvents = True
End If
If Range("D15").Value = "" And Range("D17").Value = "" And Range("D19").Value = "" Then
Range("D15").Value = "X"
End If
If Target.Address = "$D$35" Then
Application.EnableEvents = False
If Range("D35").Value <> "" Then
Range("D37").Value = ""
Range("D39").Value = ""
End If
Application.EnableEvents = True
ElseIf Target.Address = "$D$37" Then
Application.EnableEvents = False
If Range("D37").Value <> "" Then
Range("D35").Value = ""
Range("D39").Value = ""
End If
Application.EnableEvents = True
ElseIf Target.Address = "$D$39" Then
Application.EnableEvents = False
If Range("D39").Value <> "" Then
Range("D35").Value = ""
Range("D37").Value = ""
End If
Application.EnableEvents = True
End If
If Range("D35").Value = "" And Range("D37").Value = "" And Range("D39").Value = "" Then
Range("D35").Value = "X"
End If
Ende:
Application.EnableEvents = True
End Sub