Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1496to1500
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

Anzahl farbiger Felder

Anzahl farbiger Felder
13.06.2016 09:24:16
Basti
Hallo zusammen,
ich habe folgendes Anliegen: In meiner ToDo-Liste sind in Zeile 4 die Tage aufgelistet (J4=1.1., K4=2.1., L4=3.1. usw.). In Spalte A sind die Aufgaben gelistet (mit Detailinfos in den Spalten B bis I). Die Termin-Fälligkeiten der Aufgaben werden durch Farben markiert (rot = heute fällig, gelb = spätestens heute soll mit dieser Aufgabe begonnen werden). Es soll nun zu jedem Tag in der Zeile 2 ausgegeben werden, wie viele Felder in der jeweiligen Spalte von Zeile 9 bis Zeile 2000 rot bzw. gelb markiert sind. Wenn sich z.B. für den 1.1. (Spalte B) im Bereich B9 bis B2000 2 rote und 1 gelbes Feld befinden, dann soll in Zelle B2 "2r-1g" stehen.
Würd mich über eure Hilfe freuen.
LG Sebastian

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Vorschlag
13.06.2016 10:48:42
Fennek
Hallo Basti,
da es so viele Farben gibt, muss zuerst definiert werden, was "rot" und "gelb" ist. Da vba die Konstanten "vbyellow" und "vbred" anbietet, habe ich diese verwendet. D.h., in deiner Datei müssen diese Farbtöne ausgewählt werden. Z.B. mit

Sub test2()
Cells(1, 5).Interior.Color = vbRed
Cells(2, 5).Interior.Color = vbYellow
End Sub
Dann könnte dieser Code funktionieren:

Sub Basti_Her()
'ab Splate J (= 10)
lr = ActiveSheet.Range("A1").SpecialCells(11).Row
ls = ActiveSheet.Range("A1").SpecialCells(11).Columns
For s = 10 To ls 'Spalten
For r = 9 To lr 'Zeilen
If Cells(r, s).Interior.Color = vbRed Then rot = rot + 1
If Cells(2, 5).Interior.Color = vbYellow Then gelb = gelb + 1
Next r
Cells(s, 2) = rot & "r-" & gelb & "g"
rot = 0
gelb = 0
Next s
End Sub
mfg

Anzeige
AW: Vorschlag
13.06.2016 10:51:38
Fennek
sorry, kleine Änderung:
Es muss heissen:

Sub Basti_Her()
'ab Splate J (= 10)
lr = ActiveSheet.Range("A1").SpecialCells(11).Row
ls = ActiveSheet.Range("A1").SpecialCells(11).Columns
For s = 10 To ls 'Spalten
For r = 9 To lr 'Zeilen
If Cells(r, s).Interior.Color = vbRed Then rot = rot + 1
If Cells(r, s).Interior.Color = vbYellow Then gelb = gelb + 1
Next r
Cells(2, s) = rot & "r-" & gelb & "g"
rot = 0
gelb = 0
Next s
End Sub

AW: eine Musterdatei...
13.06.2016 11:11:58
UweD
wäre nicht schlecht...

..., schon um zu sehen, wie markiert wird, ...
13.06.2016 12:25:07
Luc:-?
…Sebastian,
manuell direkt oder per BedingtFormatRegel…
Gruß, Luc :-?
Besser informiert mit …
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige