Excel VBA Sub nie wykonuje się, gdy komórka docelowa jest wypełniona wartością komórki odniesienia
Nov 24 2020
Działa to świetnie w przypadku tego, co chcę, aby robił, gdy ręcznie wprowadzam wartość dla „b37”, ale kiedy wstawię na przykład „= c20” do „b37”, nic się nie dzieje. Jak to zrobić, gdy wartość w komórce, do której się odwołuje, zmienia się „c20”, zamiast ręcznie wprowadzać wartość dla „b37”? Dzięki!
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
Odpowiedzi
TimWilliams Nov 24 2020 at 19:41
Jeśli chcesz zareagować na obliczenie, a nie na ręcznie wprowadzoną wartość, możesz użyć worksheet_calculate
zdarzenia.
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
EDYCJA: jeśli masz wiele komórek do sprawdzenia, możesz rozłożyć logikę na oddzielny podrzędny i wywołać ją dla każdej pary komórek + kształtu.
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
SackOvergrowth Nov 25 2020 at 17:47
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