'For Each' ist sehr schnell, allerdings ...
15.07.2015 22:03:31
Luc:-?
…besonders über Datenfelder, etwas weniger über die hier benötigten ZellBereiche, Robert;
aber das FarbenZählen benötigst du nicht unbedingt in der UDF, denn das kann idR extern erfolgen (zB mit HÄUFIGKEIT, mit ZÄHLENWENN würdest du eine/n Hilfsspalte bzw -bereich benötigen!).
Im Folgenden stelle ich mal ein Bsp vor, bei dem alle Farben ermittelt wdn. Mit HÄUFIGKEIT kann man dann feststellen, wie oft die einzelnen Farben verwendet wurden. Benötigst du nur die Häufigkeit einer Farbe, gibst du nur die als 2.Argument von HÄUFIGKEIT an (in einer 2.Zelle wird dann die Anzahl der übrigen Farben insgesamt angegeben, wenn du die Fml als MatrixFml über 2 untereinander liegende Zellen eingibst):
| A | B | C | D | E | F | G | H | I |
1 | | | 65535 | 1x 65535 | 1x 65535 | 65535 | 65280 | 2x 65535 | 2x 65535 |
2 | | | 16777215 | 2x 16777215 | 2x 16777215 | 16777215 | 16711680 | 2x 65280 | 2x 65280 |
3 | | | 255 | 1x 255 | 1x 255 | 255 | 16777215 | 3x 16777215 | 3x 16777215 |
4 | | | 16777215 | | | 16777215 | 16711680 | 2x 16711680 | 2x 16711680 |
5 | | | 65280 | 1x 65280 | 1x 65280 | 65280 | 65535 | 1x 255 | 1x 255 |
6 | Formeln: | | C1:C5: {=ZFarben(A1:A5;JETZT())} | F1:G5: {=ZFarben(A1:B5;JETZT())} |
7 | D1:D5: {=WENN(HÄUFIGKEIT(ZFarben(A1:A5);ZFarben(A1:A5))=0;"";HÄUFIGKEIT(ZFarben(A1:A5);ZFarben(A1:A5))&"x "&ZFarben(A1:A5))} |
8 | E1:E5: {=WENN(TempStoRd(HÄUFIGKEIT(TempStoRd(ZFarben(A1:A5));TempStoRd()))=0;"";TempStoRd()&"x "&ZFarben(A1:A5))} |
9 | H1:H5: {=WENN(TempStoRd(HÄUFIGKEIT(TempStoRd(ZFarben(A1:B5));TempStoRd()))=0;"";TempStoRd()&"x "&INDEX(ZFarben(A1:B5);GANZZAHL((ZEILE()-1)/2)+1;REST(ZEILE()-1;2)+1))} |
10 | I1:I5: {=WENN(TempStoRd(HÄUFIGKEIT(TempStoRd(ZFarben(A1:B5));TempStoRd()))=0;"";TempStoRd()&"x "&MTRANS(VSplit(VJoin(MTRANS(ZFarben(A1:B5));;-2);;1)))} |
Spalten C:E zeigen Ergebnisse nur für die 1.Spalte (A), F:I für beide Spalten (A:B). HÄUFIGKEIT wandelt eine Matrix in einen vertikalen Vektor, wobei zeilenweise vorgegangen wird (erst alle Spalten der 1.Zeile, dann der 2. usw). Die Bsp-UDF ZFarben¹ liefert ein Datenfeld gleicher Form und Größe wie ihr 1.Argument. Da es sich um ein Datenfeld handelt, geht VBA bei WeiterVerarbeitung hier spalten-, nicht zeilenweise vor, was die spezielle Behandlung des reinen UDF-Ergebnisses in Spalten H:I bedingt (sonst passt es nicht zum Ergebnis von HÄUFIGKEIT).
In Spalten E;H:I habe ich außerdem eine UDF mit Merkfunktion (TempStoRd) benutzt, um die FmlLänge (auch aus Darstellungsgründen) zu verkürzen. Die musst du analog Spalte D ersetzen (ggf auch durch die Namen benannter TeilFmln → es sind 2 unterschiedliche TeilFmln!).
Falls die Fml bei ZellFarbErmittlung über mehrere Spalten (lt F:G) nicht so kompliziert wdn soll, wie in Spalte H, kämen 2 weitere UDFs ins Spiel, die im Archiv vorhanden sind (Spalte I; dazu gibt's genug Hinweise in Forum und Archiv, so dass sie bei Bedarf leicht gefunden wdn können — bei VJoin Version 1.3 →Datei-DownLoad← verwenden!).
Eine Besonderheit weist diese einfache Bsp-UDF dennoch auf, sie ist volatil. Das nutzt zwar nicht viel, weil die nachträgliche Änderung von Formaten (hier: ZellFarben) auf die übliche Weise² kein Ereignis und somit auch keine Neuberechnung auslöst, aber, wenn wenigstens einer Anwendung der UDF das optionale 2.Argument (AktDummy) mitgegeben wird (s.BspSpalten C;F:G), kann die Neuberechnung per [F9] bzw DoppelKlick in eine beliebige Zelle ausgelöst wdn. Das macht die UDF unbhängig von anderen, nur evtl ausgelösten Berechnungen.
¹ Da diese UDF nur ein Prinzip-Bsp sein soll und ggf durch eine andere ersetzt/ergänzt wdn kann, hat sie nicht die universelle Form, die man von vielen meiner UDFs gewohnt ist. Deshalb fehlen auch UrheberVermerk und Kurzbeschreibung/-anleitung.
² Anders sieht es aus, wenn Formate/Farben mit dem FormatPinsel aufkopiert wdn. Das löst ein Worksheet_Change-Ereignis aus!
Programm der Bsp-UDF:
Function ZFarben(Bereich As Range, Optional ByVal AktDummy)
Dim cn As Long, cx As Long, rn As Long, rx As Long, zFrb, ber As Range
Application.Volatile
If IsArray(Bereich) Then
cn = Bereich.Columns.Count: rn = Bereich.Rows.Count
ReDim erg(rn - 1, cn - 1)
For Each ber In Bereich
erg(rx, cx) = ber.Interior.Color
cx = (cx + 1) Mod cn: rx = rx - CInt(cx = 0)
Next ber
ZFarben = erg
Else: ZFarben = Bereich.Interior.Color
End If
End Function
Übrigens, .ColorIndex ist ab Xl12/2007 nicht mehr zu empfehlen. Die einzelnen Indizes sind mehrfach belegt, so dass ganz unterschiedliche Farben zusammengezählt wdn könnten! Außerdem sieht .Color ungefärbte Zellen als Weiß an, .ColorIndex liefert dann einen negativen Wert!
Gruß, Luc :-?