3*0,3=0,9...ODER????
29.10.2015 00:24:31
PQuest:-)
Hallo,
ich habe gerade ein kurioses Ergebnis in meinem Code
Public Sub CalendarColor()
Dim CalRow As Long, CalLastRow As Long 'first/last Row Calendar
Dim CalCol As Long, CalLastCol As Long 'first/last Column Calendar
Dim LoPRow As Long, LoPLastRow As Long 'first/last Row LoP
Dim LoPCol As Long, LoPLastCol As Long 'first/last Column LoP
Dim wsLoP As Worksheet, wsCal As Worksheet
Dim CalDay As Range 'Date from Calendar
Dim Counter As Double 'Counter for hits in LoP
Dim rngLoPDates As Range 'Date Area in LoP
Dim rngCalArea As Range 'Calendar Area
Dim rngValence As Range 'Row with valence of columns
Set wsLoP = Worksheets("ListOfPatients")
Set wsCal = Worksheets("Calendar")
CalRow = 2
CalCol = 1
With wsCal
CalLastRow = .Cells(Rows.Count, CalCol).End(xlUp).Row
CalLastCol = .Cells(CalRow, Columns.Count).End(xlToLeft).Column
Set rngCalArea = .Range(.Cells(CalRow, CalCol), .Cells(CalLastRow, CalLastCol))
End With
LoPRow = 8
LoPCol = 4
LoPLastCol = 20
With wsLoP
LoPLastRow = .Cells(Rows.Count, CalRow).End(xlUp).Row
Set rngValence = .Range(.Cells(6, LoPCol), .Cells(6, LoPLastCol))
Set rngLoPDates = .Range(.Cells(LoPRow, LoPCol), .Cells(LoPLastRow, LoPLastCol))
End With
For Each CalDay In rngCalArea
If IsEmpty(CalDay) Or CLng(CalDay.Value) < 42004 Then
Counter = 0
Else
Counter = DaysCount(CalDay, rngLoPDates, rngValence)
End If
If Counter > 1 Then
CalDay.Interior.ColorIndex = 1 'black; blue = 5; big mistake workamount overflow
ElseIf Counter = 1 Then
CalDay.Interior.ColorIndex = 3 'red
ElseIf Counter > 0.89999999 And Counter < 0.9 Then ' 3*0,3=0,9 ODER?
CalDay.Interior.ColorIndex = 46 'orange
ElseIf Counter = 0.6 Then
CalDay.Interior.ColorIndex = 6 'yellow; smooth yellow = 44
ElseIf Counter = 0.3 Then
CalDay.Interior.ColorIndex = 4 'green; smooth green = 43
Else
CalDay.Interior.ColorIndex = 0
End If
Next
End Sub
Function DaysCount(sDate, DateArea As Range, ColValence As Range) As DoubleDim arrDateArea
Dim arrColValence
Dim r As Long, c As Long 'c=Column, r=Row
Dim Val As Double
arrDateArea = DateArea.Value 'Array DateArea mit DateArea füllen (Datumsbereich im LoP)
arrColValence = ColValence.Value 'Array ColValence mit ColValence füllen (Spaltenwertigkeit)
DaysCount = 0
For r = 1 To UBound(arrDateArea, 1)
Val = 0
For c = 1 To UBound(arrDateArea, 2)
If arrDateArea(r, c) = sDate Then _
Val = WorksheetFunction.Max(Val, arrColValence(1, c))
Next
DaysCount = DaysCount + Val
Next
End Function
In der Funktion wird nur mit den Werten 0,3 und 1 gerechnet.
Die Kuriosität tuacht bei der Auswertung und Farbgebung auf
If Counter > 1 Then
CalDay.Interior.ColorIndex = 1 'black; blue = 5; big mistake workamount overflow
ElseIf Counter = 1 Then
CalDay.Interior.ColorIndex = 3 'red
ElseIf Counter > 0.89999999 And Counter < 0.9 Then ' 3*0,3=0,9 ODER?
CalDay.Interior.ColorIndex = 46 'orange
ElseIf Counter = 0.6 Then
CalDay.Interior.ColorIndex = 6 'yellow; smooth yellow = 44
ElseIf Counter = 0.3 Then
CalDay.Interior.ColorIndex = 4 'green; smooth green = 43
Else
CalDay.Interior.ColorIndex = 0
In das 2te elseif würde ich gerne 0.9 schreiben, so wie es analog bei 0.6 und 0.3 funktioniert, sollte es doch auch hier gehen.
Weit gefehlt. Ich kann an dieser Stelle nur mit einem Bereich arbeiten. Alles anders schlägt fehl.
Wo ist der Fehler?
Gruß,
PQuest:-)