• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Filter probleem door kleur functie

Status
Niet open voor verdere reacties.

Hans83

Gebruiker
Lid geworden
13 mrt 2008
Berichten
31
Hoi,

Als ik de filter uitvoer dan worden de waarde in de cellen in rij 4 #WAARDE!
als ik stap voor stap de filter uitvoer dan gaat de macro naar de funtion ColorFunction en dan loopt de filter vast.
op blad test geeft ik cellen een kleur en dit wordt weer gekoppeld naar ja of nee.
kan iemand mij helpen met het oplossen van dit probleem of weet iemand een alternatief?

Groet Hans

filter:
ActiveSheet.Range("$A$1:$I$168").AutoFilter field:=4, Criteria1:="nee"

formule in cel van rij 4:
=ALS(C7="";"";ALS(ColorFunction($M$1;test!E3368;"false")=1;"ja";"nee"))

kleurfunctie:
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function
 
Misschien wel handig als je het bestandje ook even plaatst.

De Function kan ook wel wat eenvoudiger.

Code:
Function ColorFunction(rColor As Range, rRange As Range, Optional SOM As Boolean)
  Dim cl As Range
  For Each cl In rRange
    If cl.Interior.ColorIndex = rColor.Interior.ColorIndex Then ColorFunction = IIf(SOM, ColorFunction + cl.Value, ColorFunction + 1)
  Next cl
End Function
 
Laatst bewerkt:
Probeer het zo eens
Code:
Sub Macro4()
  Application.Calculation = xlManual
  ActiveSheet.Range("$A$1:$I$168").AutoFilter 4, "nee"
  Application.Calculation = xlAutomatic
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan