Grenzen Bedingung
12.06.2006 10:42:31
arne
ich habe hier einen Fehler drin, bei dem ich keine Ahnung habe woran es liegt.
Und zwar:
Das nachfolgende Makro färbt Zellen ein, je nachdem ein bestimmter Wert erreicht wird. Im Prinzip eine bedingte Formatierung, die ich über VBA gelöst habe (kann ich Formeln per VBA reinbringen? Ich hatte da was versucht (siehe unten), aber da waren immer " " im Weg und ein % fehlte ;( ) Das Problem ist nun, dass Excel es eigentlich wie gewollt macht... eigentlich: wenn der ezi wert auf 0,6 geht und in der Wertezelle 60% enthalten sind, kein Einfärben stattfindet. Es geht bei allen anderen Grenzwerten ohne Probleme, nur bei 60% bzw. 0,6 nicht....?
Was mache ich falsch?
Danke und Gruß
Arne
Sub TNEins()
Dim Grau As Byte
Dim Weiss As Byte
Dim Wert As Range
Dim Bereich As Range
Dim WertKriterium As Range
Dim BereichKriterium As Range
Dim WertFaelle As Range
Dim AnzahlKriterien As Byte
Dim AnzahlWerte As Byte
Dim AnzahlFaelle As Byte
Dim EZI As Double
Dim BereichsWeite As Double
Dim x As Byte '/* Anzahl Skalenwerte
Dim y As Byte '/* Anzahl Kriterien
Dim z As Byte '/* Anzahl Faelle
On Error Resume Next
Application.ScreenUpdating = False
Grau = 16
Weiss = 0
BereichsWeite = 0.2
AnzahlFaelle = 4
AnzahlKriterien = 10
AnzahlWerte = 5
EZI = BereichsWeite
'Fall Eins Ausgangszellen
Set Wert = Worksheets("Target Profile").Range("B2")
Set Bereich = Worksheets("Target Profile").Range("C11")
Set WertKriterium = Worksheets("Target Profile").Range("B2")
Set BereichKriterium = Worksheets("Target Profile").Range("C11")
Set WertFaelle = Worksheets("Target Profile").Range("B2")
'los gehts
For z = 1 To AnzahlFaelle
Set Wert = WertFaelle
Set Bereich = BereichKriterium
EZI = BereichsWeite
For y = 1 To AnzahlKriterien
For x = 1 To AnzahlWerte '/* Skala
' Bereich.Select ' Test
If Wert.Value >= EZI Then
Bereich.Interior.ColorIndex = Grau
Else: Bereich.Interior.ColorIndex = Weiss
End If
EZI = EZI + BereichsWeite
Set Bereich = Bereich.Offset(ColumnOffset:=1)
' Bereich.Select 'test
Next x
'/* Ein Kriterium weiter gehen
EZI = BereichsWeite
Set WertKriterium = WertKriterium.Offset(ColumnOffset:=1)
' WertKriterium.Select
Set BereichKriterium = BereichKriterium.Offset(rowOffset:=1)
' BereichKriterium.Select
Set Wert = WertKriterium
Set Bereich = BereichKriterium
Next y
Set WertFaelle = WertFaelle.Offset(rowOffset:=1)
' WertFaelle.Select
Set BereichKriterium = BereichKriterium.Offset(rowOffset:=6)
' BereichKriterium.Select
Set WertKriterium = WertFaelle
Next z
Application.ScreenUpdating = True
End Sub
Ich dachte ich kann es so über bedingte machen:
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
Wert.Address >= EZI
Selection.FormatConditions(1).Interior.ColorIndex = 16
Aber da sind wie gesagt " " im weg und % fehlen.