Office: Farbe von Zellbereichen prüfen und andere Zelle färben

Hallo zusammen,

ich möchte in Excel mittels VBA eine Funktion realisieren und bräuchte dazu etwas Hilfe.

Ich habe ein Tabellenblatt X, in dem sich Zellen in Abhängigkeit von eingetragenen Zahlen jeweils Rot oder Grün färben (Bedingte Formatierung).

Jetzt möchte ich folgende Funktion erstellen:

Wenn im Tabellenblatt X sich in einem Zellbereich D13:N68 eine Zelle rot färbt, dann soll in einem Tabellenblatt Y eine Zelle A1 die Farbe rot erhalten.

Wenn im Tabellenblatt X alle Zellen im Bereich D13:N68 grün sind, dann soll im Tabellenblatt Y die Zelle A1 grün werden.

Meine VBA Kenntnisse reichen nicht aus, um das zu realisieren :/ Ich hoffe, ihr könnt mir weiterhelfen.

Beste Grüße

:)

 

die bedingte Formatierung auslesen ist sehr aufwendig, benutze die Bedingung um die Farbe festzustellen.

 

Kannst du genauer erklären, was du damit meinst?

Ich muss ja nicht die bedingte Formatierung auslesen, ich muss ja nur die Farbe der Zellen auslesen, die aus der Formatierung resultiert, oder nicht?

 

gut dann habe ich das falsch interpretiert. Ich dachte die Zelle wird per bedingter Formatierung rot gefärbt.
Ich bin dann raus.

 

Hallo,

tut mir Leid, ich wusste nicht, dass das nicht erlaubt ist. Wird nicht mehr vorkommen.

 

Hola,

kurz gesagt heißt das: du hast doch die Bedingungen, wann sich eine Zelle rot oder grün färbt. Diese Bedingung, die du verschweigst, kann man auch per Formel zählen, z.B. mit ZÄHLENWENN(), ZÄHLENWENNS(), SUMMENPRODUKT().

Gruß,
steve1da

 

Vielen Dank für deine Antwort.

Also ich denke, dass ich das Auslesen der Farben, die durch die bedingte Formatierung gesetzt werden, lieber sein lasse. Das scheint ja sehr kompliziert zu sein...

Ich versuche lieber genauer zu erklären, was ich vorhabe. Hier ist ein Bild der Tabelle, die ich auswerten möchte:

Fehler - imgBOX.de

Zur Erklärung beziehe ich mich auf die Zellen D12, D13 und D14.
In der Zelle D12 ist der Maximalwert eingetragen, in der Zelle D14 der Minimalwert.

In die Zelle D13 wird nun der tatsächlich vorliegende Wert eingetragen. Liegt der Wert in Zelle 13 innerhalb des Wertebereiches, der durch die Zellen D12 und D14 vorgegeben wird, so färbt sich die Zelle D13 grün. Andernfalls wird sie rot.

Diese Auswertevorschrift setzt sich Spaltenweise und alle 3 Zeilen fort.

D.h., die Zellen D15 und D17 geben wieder einen zulässigen Wertebereich für die Zelle D16 vor usw.

Wenn nun im gesamten Bereich D12:N38 nur eine Zelle rot ist, dann soll sich in einem anderen Tabellenblatt eine Zelle auch rot färben, ansonsten bleibt Sie grün.

Ich könnte jetzt natürlich alle Bedingungen für alle Blöcke durch if-Bedingungen einzeln abfragen, aber das wäre viel zu aufwändig.

Ich bräuchte eine For-Schleife o.Ä., der diese Bedingungen prüft, ohne das ich diese einzeln ausschreiben muss. Meine Kenntnisse reichen dafür nicht aus :/.

Ich hoffe, dass diese Erklärung verständlich ist.

 

Hola,

in diesem Fall wäre die Tabelle/eine Beispieltabelle sinnvoll, da das hier wohl niemand so nachbauen wird.

Gruß,
steve1da

 

Ja, das stimmt.

Unter diesem Link kann die Tabelle heruntergeladen werden:

Download Tabelle.xlsx (20.80 KB) now. Fast and easy at workupload.com

Beste Grüße und vielen Dank!

 

Hat keiner eine Idee ? Ich habe es bisher leider auch nicht realisieren können.

Beste Grüße

 

Hallo zusammen,

ich habe es mittlerweile geschafft, die Funktion zu realisieren. Für alle, die es interessiert, poste ich den Code. Evtl hat jemand noch Vorschläge, um das ganze knackiger zu gestalten, läuft aber eigentlich recht zügig durch.


Sub TestReport()

Dim max As Double 'Variable, in der die Obergrenze gespeichert wird
Dim act As Double 'Variable, in der der aktuelle Messwert gespeichert wird
Dim min As Double 'Variable, in der die Untergrenze gespeichert wird
Dim Zeile As Integer 'Variable, in der die aktuelle Zeile gespeichert wird
Dim Spalte As Integer 'Variable, in der die aktuelle Spalte gespeichert wird

Zeile = 12 'Startwert, Zeile beginnt nicht bei 0
Spalte = 4 'Startwert, Spalte beginnt nicht bei 0

Application.ScreenUpdating = False

For Zeile = 12 To 68 'Zeilenbereich, der abgefragt wird

If Zeile < 68 Then

max = ThisWorkbook.Worksheets("Scheduler Evaluation").Cells(Zeile, Spalte).Value
act = ThisWorkbook.Worksheets("Scheduler Evaluation").Cells((Zeile + 1), Spalte).Value
min = ThisWorkbook.Worksheets("Scheduler Evaluation").Cells((Zeile + 2), Spalte).Value

Zeile = Zeile + 2

If Zeile = 68 And Spalte < 16 Then

Spalte = Spalte + 1
Zeile = 11

ElseIf Zeile = 68 And Spalte = 16 Then
Exit For

End If

End If

If act = min Then

ThisWorkbook.Worksheets("Test Report").Cells(5, 4).Interior.ColorIndex = 43
ThisWorkbook.Worksheets("Test Report").Cells(5, 6).Interior.ColorIndex = 2

ThisWorkbook.Worksheets("Test Report").Select

ElseIf act > max Or act < min Then
ThisWorkbook.Worksheets("Test Report").Cells(5, 4).Interior.ColorIndex = 2
ThisWorkbook.Worksheets("Test Report").Cells(5, 6).Interior.ColorIndex = 3

Zeile = 68
Spalte = 16

ThisWorkbook.Worksheets("Test Report").Select

End If

Next Zeile

End Sub


Beste Grüße