Anzeige
Archiv - Navigation
708to712
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
708to712
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

nochmal Bedingte Formatierung mit Farbe und Muster

nochmal Bedingte Formatierung mit Farbe und Muster
14.12.2005 02:21:23
Frank
Ich wollte nur kurz mitteilen das ich es nach etlichen Stunden
geschafft habe mein Problem zu lösen. Ich habe viel dabei gelernt. :-)
Die Lösung:

Private Sub Worksheet_Activate()
Application.DisplayStatusBar = True
Application.StatusBar = "Formatiere Bereich C3 bis W29"
Application.ScreenUpdating = False
Dim zeile As Integer
Dim spalte As Integer
Dim Bereich As Range
rot = 3: Grün = 4:  Weiß = 2: hellblau = 24: gelb = 6
For zeile = 3 To 29 'Zeilen 3 bis 29
With Worksheets("Statistik 2005")
Set Bereich = .Range(.Cells(zeile, 5), .Cells(zeile, 23)) 'jeweils eine Zeile
maxi = WorksheetFunction.max(Bereich) 'minimum der Zeile berechnen
mini = WorksheetFunction.Min(Bereich) 'maximum der Zeile berechnen
For spalte = 3 To 23 Step 2 'Spalten C-W, jede 2-te
wert = .Cells(zeile, spalte).Value 'Inhalt aktuellen der Zelle
istgelb = 0
formel = Worksheets("2005").Cells((zeile - 3) * 14 + 3, spalte + 2).Formula 'Formel aus Referenzzelle
If Left(formel, 1) = "=" Then istgelb = 1 ' = 1 wenn in Referenzzelle eine Formel steht
If zeile Mod 2 = 0 Then farbe = hellblau Else farbe = Weiß ' jede 2-te Zeile hellblau
Select Case wert
Case Is = maxi
farbe = Grün:
If istgelb = 1 Then muster = xlHorizontal
Case Is = mini
farbe = rot:
If istgelb = 1 Then muster = xlHorizontal
Case Else
muster = xlGray75 ' Muster = 75% Grau
If istgelb = 1 Then farbe = gelb:
End Select
' schreibe Farb- und Musterwerte in Zelle
.Cells(zeile, spalte).Interior.ColorIndex = farbe
.Cells(zeile, spalte).Interior.Pattern = muster
.Cells(zeile, spalte).Interior.PatternColorIndex = Weiß
Next spalte
End With
Next zeile
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Danke nochmal an Luc :-?
beste Grüße
Frank Weber

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
nicht offen, Lösungsvorstellung oT
14.12.2005 08:48:58
Hajo_Zi
Anzeige

324 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige