Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1144to1148
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

dynamische Bereiche farbig absetzen

dynamische Bereiche farbig absetzen
PointOfView
Hallo und Guten Morgen Forum,
ich ermittle per VBA aus einer Datenbank diverse Werte und stelle diese in eine zeitliche Abgrenzung. Daraus entsteht eine Tabelle, die sich sukzessiv nach unten füllt. Zwischen die zeitlichen Ermittlungszeiträume grenze ich die Tabelle mit Borders (Linien unten - mittelstark) ab; siehe hierzu auch Beispieldatei unter https://www.herber.de/bbs/user/68573.xls
Die Abgrenzung ist in der Spalte Datum/Uhrzeit, dort wird der Ermittlungszeitpunkt geschrieben.
Ist es möglich, den jeweiligen Ermittlungsbereich immer wieder farblich unterschiedlich zu unterlegen, was ich dann in die Prozedur zur Datenermittlung einbinden kann? Wenn ja, wie müsste die Prozedur dazu lauten?
Bedanke mich schon mal Vorab für eure Hilfe.
Viele Grüsse
Oliver
PointOfView

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: dynamische Bereiche farbig absetzen
16.03.2010 13:24:16
fcs
Hallo Oliver,
es ist wahrscheinlich einfach, die Farbwechsel im Nachlauf zu machen. Aber du kannst natürlich versuchen, es direkt in deine Prozedur einzubinden.
Gruß
Franz
Sub Einfaerben()
Dim iFarbe As Long, Zeile As Long, Zeile1 As Long, ZeileX As Long
Dim wks As Worksheet
Dim Farbe_ColorIndex(1 To 3)
'Array mit den Farbwerten
Farbe_ColorIndex(1) = 19 'hellgelb
Farbe_ColorIndex(2) = 26  'helllila
Farbe_ColorIndex(3) = 8 'hellblau
Set wks = Worksheets("Werteliste")
With wks
Zeile1 = 2 'Zeile ab der eingefärbt werden soll
iFarbe = LBound(Farbe_ColorIndex)
For Zeile = Zeile1 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Prüfen, ob Wert Spalte P (16) vorhanden
If .Cells(Zeile, 16)  "" Then
ZeileX = Zeile 'Zeile mit Betrachtungsjahr-Eintrag
With .Range(.Cells(Zeile1, 1), .Cells(ZeileX, 16))
.Interior.ColorIndex = Farbe_ColorIndex(iFarbe)
End With
'Farbe für nächsten Bereich
'Prüfen, ob letzte Farbe im vorherigen Bereich verwendet wurde
If iFarbe = UBound(Farbe_ColorIndex) Then
iFarbe = LBound(Farbe_ColorIndex) '1. Farbe
Else
iFarbe = iFarbe + 1
End If
Zeile1 = Zeile + 1 'Startzeile für nächsten Bereich
End If
Next
End With
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige