Excel VBA script Count Cell Color werkt niet optimaal

[Verwijderd]

Ik heb online een VBA script gevonden over het optellen van gekleurde cellen (zie onderaan)
Het doel was om de formule =CountCcolor te gebruiken in een ALS formule zodat het mogelijk werd om cellen een bepaalde kleur te geven en aan de hand van de kleur zou de formule bepalen in welke kolom het getal ingevuld zou worden.

Een voorbeeld van deze formule: (hier worden meerdere kleuren meegenomen, de W,X en Y cellen zijn de basis kleuren, cel U22 heeft de kleur van Y en is dus 1, hierdoor wordt de waarde van cell U22 gekopiërd in cell Y22)
=ALS(OF(CountCcolor(U22;$W$20)=1;CountCcolor(U22;$X$20)=1;CountCcolor(U22;$Y$20)=1);U22;0)

In een test bestand werkt het perfect. Het probleem is dat je de kleur alleen kunt vervangen via: Opmaak kopiëren/plakken van een al bestaande kleur in het werkblad.
helaas is het productie werkblad 10.000 regels groot en ben ik niet van plan om elke keer naar boven te scrollen, de juiste kleur te kopiëren en weer naar beneden te scollen...

Is het mogelijk om iets in het VBA script aan te passen waardoor ik de opvulkleur optie kan gebruiken en dat de formule deze kleur dan ook meeneemt?


Function CountCcolor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
If datax.Interior.ColorIndex = xcolor Then
CountCcolor = CountCcolor + 1
End If
Next datax
End Function

[RobIII]

Sorry, maar dit is niet heel veel meer dan een scriptrequest / Kan iemand even...?-topic en dat is niet de bedoeling hier in Programming. Voor support op code van derden kun je 't best bij die derden aankloppen. Mocht je toch wat meer input willen, open dan een nieuw topic per onze Quickstart waarin je laat zien wat je zelf al gezocht, gevonden en geprobeerd hebt en je aan de andere zaken uit de quickstart houdt Gebruik ook code tags wanneer je code post a.u.b.

Als alternatief kan ik je Devschuurder werven? Gebruik Vraag & Aanbod! bieden.