AW: periodische maximums anzeigen lassen
15.08.2006 20:23:17
ingUR
Hallo,
vieleicht ist das Thema nicht mehr aktuell, doch der Vollständigkeit halber hier nun eine etwas verallgemeinerte Fassung der Modul-Prozedur, die zudem die Ergänzung enthält, dass die Markierung aus der vorherigen Prüfung vor der neuen Prüfung entfernt werden und dass wahlweise gleitende und sequientiele Periodenabschnitte untersucht werden können. Zudem wird die Periodenlänge abgefragt und die Anzahl der zu berücksichtigenden Zeilen, richtet sich nach dem letzten Eintrag in der Spalte A.
Option Explicit
Sub PeriodenMaximum()
Dim r As Range, rng As Range, maxrC As Range
Dim maxV As Double
Dim color1 As Integer, color2 As Integer, colorMax As Integer, colorp As Integer
Dim p As Long, periode As Integer, pstep As Integer, lastR As Long
Dim antwort As VbMsgBoxStyle
periode = InputBox("Periodenlänge =")
antwort = MsgBox("Gleitender Periode", vbYesNo)
If antwort = vbYes Then pstep = 1 Else pstep = periode
color1 = 35
color2 = 36
colorMax = 3
colorp = color1
Columns("A:A").Interior.ColorIndex = xlNone
lastR = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
lastR = pstep * CInt(lastR / pstep + 1)
For p = periode To lastR - 1 Step pstep
Set rng = Range("A" & p - periode + 1 & ":A" & p)
If pstep > 1 Then
rng.Interior.ColorIndex = colorp
If colorp = color1 Then colorp = color2 Else colorp = color1
End If
maxV = rng.Cells(1).Value
Set maxrC = rng.Cells(1)
For Each r In rng
If r.Value > maxV Then
maxV = r.Value
Set maxrC = r
End If
Next
maxrC.Interior.ColorIndex = colorMax
Set rng = Nothing
Set maxrC = Nothing
Next
End Sub
Gruß!