Office: Zelle auf Hintergrundfarbe prüfen

HalfNOoB · 28. November 2014

Hei Leute

Ich hab fast keine Ahnung von VBA und bin deshalb wohl der Dümmste hier *grins Ich hab aber ein Problem das sich ned so einfach lösen lassen wird ohne VBA...

Naja, auf jeden Fall mal hier meine Frage: Ich hab den Auftrag erhalten, die Ferienliste anzupassen. Und zwar soll auf einen Blick ersichtlich sein, wie viele Prokuristen und wie viele Handlungsbevollmächtigte am jeweiligen Tag da sind.
Der Ferienplan ist wie folgt aufgebaut: Die Mitarbeiter tragen in entsprechenden Farben am entsprechenden Tag ihre Absenz ein. Wenn keine Farbe eingetragen ist, bedeutet das, dass sie da sind.

1) Überprüfen ob die Zellen in einem Bereich keine Hintergrundfarbe besitzen

2) Wenn sie keine besitzen, in Spalte B springen

3) Wenn in Spalte B "Handlungsbevollmächtigter" steht, zum Zähler IV dazuzählen / Wenn in Spalte B "Prokurist" steht, zum Zähler PP dazuzählen

Ich hab mich mal schlau (bin aber immer noch dumm) gemacht im Inet:
Code:

Public Function ZählenWennIV(Bereich As Range, SuchFarbe As Variant, _
Optional Zählen_Bereich As Range) As Double

'© Thomas Ramel / 30.05.2003 // abgeändert

Dim intI As Integer
Dim intColor As Integer
Dim ZählerIV As Integer

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Zählen_Bereich Is Nothing Then Set Zählen_Bereich = Bereich

For intI = 1 To Bereich.Count
If Bereich(intI).Interior.ColorIndex = intColor Then
ZählerIV = ZählerIV + 1
End If
Next intI

ZählenWennIV = ZählerIV
End Function

Public Function ZählenWennPP(Bereich As Range, SuchFarbe As Variant, _
Optional Zählen_Bereich As Range) As Double

'© Thomas Ramel / 30.05.2003 // abgeändert

Dim intI As Integer
Dim intColor As Integer
Dim ZählerPP As Integer

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Zählen_Bereich Is Nothing Then Set Zählen_Bereich = Bereich

For intI = 1 To Bereich.Count
If Bereich(intI).Interior.ColorIndex = intColor Then
ZählerPP = ZählerPP + 1
End If
Next intI

ZählenWennPP = ZählerPP
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Diese beiden Funktionen tun im Moment das genau Gleiche: Sie geben mir die Anzahl Zellen ohne Hintergrundfarbe an. Bei den beiden Funktionen fehlt jedoch der Sprung in Spalte B. Dort sollte der Inhalt überprüft werden.

Könnte jemand den Code so anpassen, dass die Spalte B auf den Inhalt geprüft wird? Und wenn in dieser "Handlungsbevollmächtigter" steht, +1 dazuzählen? Und wenn darin "Prokurist" steht, +1 dazuzählen? Danke im Voraus *Smilie

Abgabetermin ist morgen *entsetzt *entsetzt *entsetzt *entsetzt *entsetzt *entsetzt

Thanks und Mfg HalfNOoB

:)

Hajo_Zi · 30. November 2014

ich kann Deine Datei nicht sehen, darum kann ich wohl auch nicht sehen ob die Farbe mittels bedingte Formatierung erstellt wird. Diese Auswertung lasse sein die ist sehr aufwendig.

Mc Santa · 30. November 2014

Hallo Hajo,

aus der Beschreibung wird für mich deutlich, dass es sich nicht um eine bedingte Formatierung handelt.

Viele Grüße
Santa

GMG-CC · 30. November 2014

Moin,

leider ist deine Beschreibung für mich nicht so wirklich klar ...
Darum eine Nachfrage: Gibt es feste Bereiche mit Hintergrundfarben oder setzen die MA selbst die Hintergrundfarbe?

HalfNOoB · 30. November 2014

Die Mitarbeiter setzen die Farben selbst und ohne bedingte Formatierung. Die Einfärbung wird manuell eingetragen via Register 'Start'-->'Schriftart'

Ich hab mich kurz hingesetzt um ein Beispiel zu erstellen wie es ungefähr aussieht. Ich hoffe dass es nun verständlicher ist...

Danke *Smilie

HalfNOoB · 30. November 2014

Also: Ich bin der Sache einen Schritt näher gekommen. Ich habe bereits einige Erfahrungen in C++ gemacht und weiss deshalb wie ungefähr die For-Schlaufe aufgebaut ist. Folgende Änderungen habe ich daran vorgenommen:

Code:

For intI = 1 To Bereich.Count
MsgBox ActiveSheet.Cells(intI + 2, 2).Value
If Bereich(intI).Interior.ColorIndex = intColor Then
If ActiveSheet.Cells(intI + 2, 2).Value = Handlungsbevollmächtigter Then
ZählerIV = ZählerIV + 1
Else
ZählerIV = ZählerIV
End If
End If
Next intI
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Er soll den Bereich durchloopen und im nächsten Schritt immer den Wert der Spalte B (=2) auf der entsprechenden Zeile (intI +2) in einer MsgBox ausgeben. Die Ausgabewerte stimmen überein!

Jedoch scheint jetzt bei einem der If-Statements etwas schiefzulaufen. Kann mir da einer helfen?

HalfNOoB · 30. November 2014

In dem obigen If-Statements werden nur diejenigen Felder gezählt, die keine Farbe haben, und deren Spalte B leer steht. Ich möchte jedoch, dass diejenigen Felder gezählt werden, die keine Farben besitzen aber, bei denen Handlungsbevollmächtigter / Prokurist in Spalte B steht.

Wie muss ich die Statements anpassen?

amicro2000 · 30. November 2014

Hallo auch,

Hier mal die Funktion für ZählenWennIV:

Code:

Public Function ZählenWennIV(Bereich As Range, SuchFarbe As Variant, _
Optional Zählen_Bereich As Range) As Double

'© Thomas Ramel / 30.05.2003 // abgeändert

Dim intColor As Integer
Dim ZählerIV As Integer
Dim rng As Range

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Zählen_Bereich Is Nothing Then Set Zählen_Bereich = Bereich

For Each rng In Bereich
If rng.Interior.ColorIndex intColor Then
If Cells(rng.Row, 2) = "Handlungsbevollmächtigter" Then ZählerIV = ZählerIV + 1
End If
Next rng

ZählenWennIV = ZählerIV
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

AAAAAAbbbbbbeeerrr: Funktionen werden beim ändern der Hintergrundfarbe nicht ausgelöst.

Sag Ich bloß mal so dazu.

HalfNOoB · 30. November 2014

Wow Danke! Das funktioniert wie geplant *cool.gif* *biggrin.gif* *biggrin.gif*

Wie bereits amicro2000 angetönt, aktualisiert sich die Formel nicht von selber, egal ob ich z.B. die Funktion von Fridolin Müller von 'leer' zu Handlungsbevollmächtigter umschalte...*frown.gif*

Hat jemand eine Idee wie man das automatisch machen kann? (wie z.B. bei der normalen Summe-Formel, wenn was angepasst wird im definierten Bereich, aktualisiert sich das Resultat)

Edit: Zum Beispiel ein Makro-Button mit Hilfe dessen man die Bereiche und die Funktion neu überprüfen kann / die Formeln erneut ausführen kann

amicro2000 · 30. November 2014

Hei,

Mach anstatt Hintergrundfarbe einfach ein x rein,

und nimm das:

Code:

Public Function ZählenWennIV(Bereich As Range, SuchFarbe As Variant, _
Optional Zählen_Bereich As Range) As Double

'© Thomas Ramel / 30.05.2003 // abgeändert
'Application.Volatile

Dim intColor As Integer
Dim ZählerIV As Integer
Dim rng As Range

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Zählen_Bereich Is Nothing Then Set Zählen_Bereich = Bereich

For Each rng In Bereich
If LCase(rng) = "x" Then
If Cells(rng.Row, 2) = "Handlungsbevollmächtigter" Then ZählerIV = ZählerIV + 1
End If
Next rng

ZählenWennIV = ZählerIV
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

amicro2000 · 30. November 2014

Hei,

oder du machst es mit Kürzel, in deinem Fall F, M und D bzw. f, m und d.

und dieser Formel:

Code:

Public Function ZählenWennIV(Bereich As Range, SuchFarbe As Variant, _
Optional Zählen_Bereich As Range) As Double

'© Thomas Ramel / 30.05.2003 // abgeändert
'Application.Volatile

Dim intColor As Integer
Dim ZählerIV As Integer
Dim rng As Range

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Zählen_Bereich Is Nothing Then Set Zählen_Bereich = Bereich

For Each rng In Bereich
If LCase(rng) = "f" Or LCase(rng) = "m" Or LCase(rng) = "d" Then
If Cells(rng.Row, 2) = "Handlungsbevollmächtigter" Then ZählerIV = ZählerIV + 1
End If
Next rng

ZählenWennIV = ZählerIV
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Du kannst dann sogar noch mit Bedingter Formatierung diese Kürzel z.b. F Farbig hervorheben.

HalfNOoB · 30. November 2014

Danke für den Vorschlag Amicro, aber irgendwie scheint das nicht zu funktionieren...

Hier ist der aktuelle Code, der so funktioniert wie geplant:

Code:

Public Function ZählenWennIV(Bereich As Range, SuchFarbe As Variant, _
Optional Zaehlen_Bereich As Range) As Double

'© Thomas Ramel / 30.05.2003 // abgeändert

Dim intI As Integer
Dim intColor As Integer
Dim ZaehlerIV As Integer

ZaehlerIV = 0

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Zaehlen_Bereich Is Nothing Then Set Zaehlen_Bereich = Bereich

For intI = 1 To Bereich.Count
'MsgBox ActiveSheet.Cells(intI + 2, 2).Value
If Bereich(intI).Interior.ColorIndex = intColor Then
'MsgBox ("Color found!")
If ActiveSheet.Cells(intI + 2, 2).Value = "IV" Then
'MsgBox ("Zähler erhöht")
ZaehlerIV = ZaehlerIV + 1
End If
End If
Next intI

ZählenWennIV = ZaehlerIV
End Function

Public Function ZählenWennPP(Bereich As Range, SuchFarbe As Variant, _
Optional Zaehlen_Bereich As Range) As Double

'© Thomas Ramel / 30.05.2003 // abgeändert

Dim intI As Integer
Dim intColor As Integer
Dim ZaehlerPP As Integer

ZaehlerPP = 0

If IsObject(SuchFarbe) Then
intColor = SuchFarbe(1).Interior.ColorIndex
Else
intColor = SuchFarbe
End If

If Zaehlen_Bereich Is Nothing Then Set Zaehlen_Bereich = Bereich

For intI = 1 To Bereich.Count
'MsgBox ActiveSheet.Cells(intI + 2, 2).Value
If Bereich(intI).Interior.ColorIndex = intColor Then
'MsgBox ("Color found!")
If ActiveSheet.Cells(intI + 2, 2).Value = "PP" Then
'MsgBox ("Zähler erhöht")
ZaehlerPP = ZaehlerPP + 1
End If
End If
Next intI

ZählenWennPP = ZaehlerPP
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie könnte man diesen Code so einfach wie möglich 'automatisieren'? :/

GMG-CC · 1. Dezember 2014

Also,

für den Januar habe ich dir das Ganze mal automatisiert.

Bereich markieren

Schaltfläche drücken

Freuen. *Smilie (Falls ich dich nicht falsch verstanden habe.)

Nachtrag: Bitte die Zeile Code:

rngData.Select
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

löschen, hatte ich nur zu Kontrollzwecken eingebaut.

HalfNOoB · 1. Dezember 2014

\@GMG-CC

1) Das funktioniert perfekt mit automatischer Aktualisierung! *biggrin.gif* *biggrin.gif* *biggrin.gif* *biggrin.gif*

2) Ich versteh nur Bahnhof beim Makro *boah Die echte Ferienliste ist einiges komplexer aufgebaut (z.B. verbundene Zeilen) und ich habe keine Ahnung wie ich deinen ultimativen Makro-Code auf andere Monate resp. den richtigen Ferienplan anwenden kann... Meine ursprüngliche Idee war, einen für mich verständlichen Code dann auf die einzelnen Blätter anzuwenden, was hier aber für mich unmöglich erscheint :O

Ich hab hier ne Kopie von dem Dokument, ohne Namen *wink.gif* (Das Dokument war zu gross um es per Anhang hier hochzuladen... Ich bin auch offen für Vorschläge mit bedingter Formatierung oder so.

http://www.file-upload.net/download-...opie.xlsx.html

Mfg HalfNOoB

GMG-CC · 1. Dezember 2014

Na ja,

das Prinzip ist das gleiche. Von der letzten Spalte (lCol) müsste 2 subtrahiert werden. Inwieweit die verbundenen Zellen betroffen sind, kann ich nicht sagen, weil ich nicht weiß, wohin die Ergebnisse geschrieben werden sollen.

Ansonsten: Ein Forum ist IMHO dazu gedacht, Hilfe zur Selbsthilfe zu geben. Das hast du ja auch schon erkennen lassen durch deinen Kompromiss "mit bedingter Formatierung oder so" ... *wink.gif*

Ich habe dir auch noch eine eMail dazu geschrieben.

Office: Zelle auf Hintergrundfarbe prüfen

Zelle auf Hintergrundfarbe prüfen

Zelle auf Hintergrundfarbe prüfen

Zelle auf Hintergrundfarbe prüfen

Zelle auf Hintergrundfarbe prüfen

Zelle auf Hintergrundfarbe prüfen

Zelle auf Hintergrundfarbe prüfen - Similar Threads - Zelle Hintergrundfarbe prüfen

Hinzufügen oder Ändern der Hintergrundfarbe von Zellen

Mittels Steuerelement Hintergrundfarbe einer Zelle ändern

Hintergrundfarbe aus Zelle auslesen und Datenpunkt in Diagramm zuweisen

Bei Eingabe in Zellen Hintergrundfarbe ändern

Ändern der Hintergrundfarbe einer Zelle bei Auswahl bestimmter anderer Zellen

Mehrere Hintergrundfarben pro Zelle

kann man zellen nach Hintergrundfarbe markieren?