Excel VBA Sub wird nicht ausgeführt, wenn die Zielzelle mit dem Referenzzellenwert gefüllt ist

Question

Dies funktioniert hervorragend für das, was ich möchte, wenn ich den Wert für "b37" manuell eingebe, aber wenn ich beispielsweise "= c20" in "b37" eingebe, passiert nichts. Wie funktioniert das, wenn sich der Wert in der Zelle, auf die verwiesen wird, "c20" ändert, anstatt manuell einen Wert für "b37" einzugeben? Vielen Dank!

Sub Worksheet_Change(ByVal target As Range)
    If Intersect(target, Range("b37")) Is Nothing Then Exit Sub
    If IsNumeric(target.Value) Then
        If target.Value < 0.95 Then
            ActiveSheet.Shapes("Straight Connector 1").Line.ForeColor.RGB = vbRed
        ElseIf target.Value >= 0.95 And target.Value < 1 Then
            ActiveSheet.Shapes("Straight Connector 1").Line.ForeColor.RGB = vbGreen
        Else
            ActiveSheet.Shapes("Straight Connector 1").Line.ForeColor.RGB = vbYellow
        End If
    End If
End Sub

Answer 1

Wenn Sie auf eine Berechnung und nicht auf einen manuell eingegebenen Wert reagieren müssen, können Sie das worksheet_calculateEreignis verwenden.

Private Sub Worksheet_Calculate()
    Dim v, clr As Long

    v = Me.Range("B37").value
    If not isnumeric(v) or len(v) = 0 then exit sub

    If v < 0.95 Then
        clr = vbRed
    ElseIf v >= 0.95 And v < 1 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    Me.Shapes("Straight Connector 1").Line.ForeColor.RGB = clr
End Sub

BEARBEITEN: Wenn Sie mehrere Zellen überprüfen müssen, können Sie die Logik in ein separates Sub zerlegen und für jedes Paar von Zelle + Form aufrufen.

Private Sub Worksheet_Calculate()
    SetLineColor Me.Range("B37"), Me.Shapes("Straight Connector 1")
    SetLineColor Me.Range("B40"), Me.Shapes("Straight Connector 8")
End Sub

Sub SetLineColor(c As Range, ln As Shape)
    Dim v, clr As Long

    v = c.value
    If not isnumeric(v) or len(v) = 0 then exit sub

    If v < 0.95 Then
        clr = vbRed
    ElseIf v >= 0.95 And v < 1 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    ln.Line.ForeColor.RGB = clr
End Sub

Answer 2

Private Sub Worksheet_Calculate()
    SetLineColor1 Me.Range("B37"), Me.Shapes("Line 1")
    SetLineColor2 Me.Range("D35"), Me.Shapes("Line 2")
End Sub

Sub SetLineColor1(c As Range, ln As Shape)
    Dim v, clr As Long

    v = c.Value
    If Not IsNumeric(v) Or Len(v) = 0 Then Exit Sub

    If v < 0.95 Then
        clr = vbRed
    ElseIf v >= 0.95 And v < 1 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    ln.Line.ForeColor.RGB = clr
End Sub
Sub SetLineColor2(c As Range, ln As Shape)
    Dim v, clr As Long

    v = c.Value
    If Not IsNumeric(v) Or Len(v) = 0 Then Exit Sub

    If v < 88 Then
        clr = vbRed
    ElseIf v >= 88 And v < 100 Then
        clr = vbGreen
    Else
        clr = vbYellow
    End If
    ln.Line.ForeColor.RGB = clr
End Sub