Hi,
hab das ganze bißchen optimiert, funktioniert aber immer noch nicht richtig.
Ideen?
Sub ...()
Dim banz As Integer
Dim Note5 As Double
Dim stand As Date
anzz = Sheets("tabelle1").Cells(Rows.Count, 10).End(xlUp).Row
banz = anzz - 2
stand = Sheets("tabelle1").Cells(3, 7).Value
For i = 1 To banz
k = i + 2
Note5 = 0
stand = Sheets("tabelle1").Cells(3, 7).Value
If stand < Sheets("Gesamtübersicht").Cells(k, 6).Value Then
Note5 = Sheets("tabelle2").Cells(6, 11).Value
Else:
If stand < Sheets("tabelle1").Cells(k, 5).Value Then
Note5 = Sheets("tabelle2").Cells(5, 11).Value
Else:
If stand < Sheets("tabelle1").Cells(k, 4).Value Then
Note5 = Sheets("tabelle2").Cells(4, 11).Value
Else:
If stand < Sheets("tabelle1").Cells(k, 3).Value Then
Note5 = 5
Else: Note5 = Sheets("tabelle2").Cells(4, 11)
End If
End If
End If
End If
Sheets("tabelle2").Cells(k, 13).Value = Note5
'um zu sehen was als Note5 abgespeichert wird.
If Sheets("tabelle1").Cells(k, 10).Value <= Note5 Then
Sheets("tabelle1").Cells(k, 10).Activate
Sheets("tabelle1").Cells(k, 10).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else: Sheets("tabelle1").Activate
Sheets("tabelle1").Cells(k, 10).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
Next
End Sub
farel schrieb am 13.10.2008 09:21:04:
Hi Leute,
hab ein kleines Makro geschrieben, das nicht so funktioniert wie ich will. Kann mir jemand helfen?
Funktion:
In Tabelle 1 von C bis G sind Daten gespeichert. G= aktuell, die anderen sind Fixe Zeitpunkte(wobei F der letzte, C der erste ist).
Je nachdem in welchem Intervall das aktuelle Datum liegt soll als Note5 ein in Tabelle2 abgelegter Wert verwendet werden. Dieser Referenzwert wird dann verglichen, mit dem Wert aus Tabelle 1 in der Spalte10. Ist der Wert in der Spalte 10 Größer als der Referenzwert soll die Zelle rot, andernfalls grün gefärbt werden.
Mein Makro will das leider nicht ausführen, vor allem meckert er bei den Else anweisungen.
Das ganze soll er für alle Zeilen, ab Zeile 3 machen(deswegen die For mit k=i+2)
Wer weiss weiter?
Danke im Voraus.
Farel
Sub name1()
Dim banz As Integer
Dim Note5 As Double
Dim stand As Date
anzz = Sheets("tabelle1").Cells(Rows.Count, 10).End(xlUp).Row
banz = anzz - 2
stand = Sheets("tabelle1").Cells(3, 7).Value
For i = 1 To banz
k = i + 2
If stand < Sheets("tabelle1").Cells(k, 6).Value Then Note5 = Sheets("tabelle2").Cells(6, 11).Value
Else: If stand < Sheets("tabelle1").Cells(k, 5).Value Then Note5 = Sheets("tabelle2").Cells(5, 11).Value
Else: If stand < Sheets("tabelle1").Cells(k, 4).Value Then Note5 = Sheets("tabelle2").Cells(4,11).Value
Else: If stand < Sheets("tabelle1").Cells(k, 3).Value Then Note5 = 5
Else: Note5 = Sheets("tabelle2").Cells(4, 11).Value
If Sheets("tabelle1").Cells(k, 10).Value < Note5 Then Sheets("tabelle1").Cells(k, 10).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Sheets("tabelle1").Activate
Sheets("tabelle1").Cells(k, 10).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Next
End Sub
|