Code um eine Spaltenabfrage ergänzen
28.02.2020 20:06:52
Wolfgang
den nachfolgenden Code erhielt ich hier aus dem Forum. Er läuft wunderbar und einwandfrei. Nun hätte ich allerdings eine Bitte bzw. eine Frage nach Erweiterung des Codes. Ich würde gerne erreichen, dass an der Stelle, an der der Sitz und die Lampe grün werden, eine weitere Spalte - nämlich Spalte N einbezogen wird und der Stuhl z.B. in blaugrau gefärbt wird, wenn die Zelle in Spalte N den Text "TV" enthält. Enthält die Zelle in Spalte N den Text "TN" die Lampe z.B. die Farbe Orange erhält. Alle anderen Features sollten so bleiben. - Ich würde mich über Rückmeldungen sehr freuen. - Herzliche Grüße Wolfgang
Sub Einfärben()
Dim i As Integer, letzZ As Integer, x As Integer
letzZ = Tabelle2.[I1000].End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To 15
Tabelle1.Shapes.Range(Array("Sitz" & i)).Fill.ForeColor.RGB = RGB(255, 0, 0) _
'Rot
Tabelle1.Shapes.Range(Array("Lamp" & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
Next
For i = 2 To letzZ
x = Tabelle2.Cells(i, 12)
If Tabelle2.Cells(i, 9) = Date Then
Tabelle1.Shapes.Range(Array("Sitz" & x)).Fill.ForeColor.RGB = RGB(64, 130, 63) _
'Grün
Tabelle1.Shapes.Range(Array("Lamp" & x)).Fill.ForeColor.RGB = RGB(64, 130, 63)
End If
If Tabelle2.Cells(i, 9) > Date Then
Tabelle1.Shapes.Range(Array("Lamp" & x)).Fill.ForeColor.RGB = RGB(10, 85, 151) _
'Blau
End If
If Tabelle2.Cells(i, 8) = "storniert" Then _
'Frei geworden
Tabelle1.Shapes.Range(Array("Sitz" & x)).Fill.ForeColor.RGB = RGB(255, 0, 0) _
'Rot
Tabelle1.Shapes.Range(Array("Lamp" & x)).Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
If Tabelle2.Cells(i, 10)