Private Sub Worksheet_Calculate()
FarbeZeit
End Sub
Und dann in Modul1Sub FarbeZeit()
Dim x As Integer
Dim festNr As Long
x = -1
Do
x = x + 1
If Range("Tabelle2[Vorbedingung]").Range("A1").Offset(x, 0) "" Then
festNr = Range("Tabelle2[Nr.]").Range("A1").Offset(x, 0).Value
With Tabelle1.Shapes("Zeit " & festNr).Fill
.ForeColor.RGB = RGB(255, 0, 0)
End With
End If
Loop Until x > 300
End Sub
Jedoch wird die Form nicht sofort farblich markiert, sondern erst wenn ich ein Zeile irgendwo hinzufüge oder so.Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells(1).Address(False, False) = "A5" Then
If Target.Cells(1) "" Then
ActiveSheet.Shapes("Rechteck 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
ActiveSheet.Shapes("Rechteck 1").Fill.Visible = msoFalse
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim y As Integer
y = -1
Do
y = y + 1
If Range("Tabelle2[Vorbedingung]").Range("A1").Offset(y, 0) "" Then
FarbeZeit
End If
Loop Until y > 400
End Sub
Weil das ganze Tabellenblatt-übergreifend gehen soll, macht ihr in z.B. Modul1 folgendes rein.Sub FarbeZeit()
Dim x As Integer
Dim festNr As Long
On Error GoTo Vorbei
x = -1
Do
x = x + 1
If Range("Tabelle2[Vorbedingung]").Range("A1").Offset(x, 0) "" Then
festNr = Range("Tabelle2[Nr.]").Range("A1").Offset(x, 0).Value
With Tabelle1.Shapes("Zeit " & festNr).Fill
.ForeColor.RGB = RGB(255, 0, 0)
End With
End If
Loop Until x > 300
Vorbei:
End Sub