Supportnet / Forum / Tabellenkalkulation
ampeln mit farben auslesen
Frage
Hallo ihr alle,
stehe auf dem Schlauch,
mein Programm geht durch eine Tabelle spalten-und zeilenweise in der mehrere Ampeln(Zellen)geschaltet sind. wenn die zelle grün ist, gehe weiter bis zur nächsten zelle,solange bis eine rote vorhanden ist,und setze die gesamtampel(x,anfangspalte) auf rot, dann geh aus der for-schleife raus). Wenn rot nicht vorhanden, dann geh auf gelb(usw.). das macht das programm, wenn nun eine zeile aber gar keine ampeln hat, soll auch die gesamtampel keinen wert haben(also weiss sein). wenn ich das als else anweisung eingebe, hängt sich das programm auf!!1 Sieht jemand warum und wie ich das ändern kann...? Falls jemand einen einfacheren Code für das Programm weiss, bin ich auch sehr dankbar dafür...
grüsse
annette
der code ist leider etwas verschoben, hoffentlich könnt ihr ihn trotzdem deuten
Public Sub Ampel()
Dim bsc As Worksheet
Dim x As Long
Dim y As Integer
Dim AnfangSpalte As Integer
x = 5
y = 35
AnfangSpalte = 18
On Error GoTo fehler
Set bsc = Worksheets("Gesamt")
Do While x < 100
'
For y = 35 To 255 Step 1
Select Case bsc.Cells(x, y).Interior.ColorIndex And _
bsc.Cells(x, y).Offset(0, 1) <> ""
Case Is = 4
bsc.Cells(x, AnfangSpalte).Interior.ColorIndex = 4
Case Else
If bsc.Cells(x, y).Offset(0, 1) <> "" Then
If bsc.Cells(x, y).Interior.ColorIndex = 3 Then
bsc.Cells(x, AnfangSpalte).Interior.ColorIndex = 3
Exit For
Else
If bsc.Cells(x, y).Interior.ColorIndex = 6 Then
bsc.Cells(x, AnfangSpalte).Interior.ColorIndex = 6
Exit For
End If
End If
Else
' bsc.Cells(x, AnfangSpalte).Interior.ColorIndex = 2
End If
End Select
Next y
x = x + 1
Loop
Exit Sub
fehler:
MsgBox "hier hast du was falsch gemacht"
End Sub
Antwort 1 von nighty
hi annette :)
case und if gemischt und den überblick verloren ,daher benutze doch nur eines ,CASE oder IF THEN ELSE struckturen :))
gruss nighty
case und if gemischt und den überblick verloren ,daher benutze doch nur eines ,CASE oder IF THEN ELSE struckturen :))
gruss nighty