Code vba plusieurs couleurs

[laplayast]

Bonjour,

Dans le code ci-dessous à la ligne 4, avec une seule couleur la fonction remplie sont rôle; mais avec plus de couleurs
cela ne marche plus. Justement ce modèle avec 4 couleurs ou plus m'intérresse.
Comment adapter cela?.
Merci



Function NbCoul(Zne As Range, Couleur As String)
Application.Volatile True
For Each cell In Zne
'''''''If cell.Interior.ColorIndex =43;33;3;6 Then NbCoul = NbCoul + 1
Next
NbCoul = NbCoul
End Function
'Création Fonction pour récupérer le numéro couleur de remplissage
Function Couleur(CL As Range) As Long
Couleur = CL.Interior.ColorIndex
End Function

 

[Hieu]

Re : Code vba plusieurs couleurs

Salut,

Quelque chose comme ça ?

Function NbCoul(Zne As Range, Couleur As String)
Application.Volatile True
For Each cell In Zne
    Select Case cell.Interior.ColorIndex
        Case 43, 33, 3, 6
            NbCoul = NbCoul + 1
    End Select
Next cell
' la ligne en dessous est inutile
' NbCoul = NbCoul
End Function

'Création Fonction pour récupérer le numéro couleur de remplissage
Function Couleur(CL As Range) As Long
Couleur = CL.Interior.ColorIndex
End Function

++

 

[Modeste geedee]

Re : Code vba plusieurs couleurs

Bonsour®
For .......
'--------'''''''----------
With cell.Interior
if .ColorIndex =43 _
or .ColorIndex=33 _
or .ColorIndex=3 _
or .ColorIndex=6 Then NbCoul = NbCoul + 1
End With
'---------------
next

 

[laplayast]

Re : Code vba plusieurs couleurs

Bonjour,
Et merci,

Je souhaiterai integrer à la fonction "Nbcoul", la valeur du nombre de cellules de couleur trouvée, en fonction du choix de la couleur decidée dans la formule.
A ce stade il s'agit de la macro qui m'en empêche
Je ne vois pas comment l'integrer.

Début essai en cellule F5; le but etant de compter la couleur qui apparait dans la plage E5;E14, puisqu'il n'y'aura qu'un choix à la fois. Je suis obligé de shunter les autres couleurs dans la macro ce qui n'est pas le but.Voir fichier joint.

Merci

 

[Modeste geedee]

Re : Code vba plusieurs couleurs

Bonsour®

function modifiée :

Function NbCoul(Zne As Range, CoulIdx )
Application.Volatile True
NbCoul=0
For Each cell In Zne
   If cell.Interior.ColorIndex = CoulIdx Then NbCoul = NbCoul + 1  
Next cell
End Function

en D5 :
=NbCoul($E$5:$E$14;B5)
ou
=NbCoul($E$5:$E$14;8)

 

[laplayast]

Re : Code vba plusieurs couleurs

Bonjour,
Fonctionne nickel merci,

Dans le code suivant aux tirets, il détecte nom ambigu je ne vois pas pourquoi? Quelle solution? merci.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not IsEmpty(celluleAvant) Then
If Not Intersect(Range(celluleAvant), [E5:LV30]) Is Nothing Then Calculate
End If
celluleAvant = Target.Address
If Not Application.Intersect(Target, Range("E5:LV30")) Is Nothing And Target.Count = 1 Then 'Adapter la plage
UserForm1.Show
End If
End Sub


Private Sub CommandButton1_Click()
ThisWorkbook.Sheets("sommaire").Activate
ActiveWindow.WindowState = xlMaximized
Application.DisplayFullScreen = False
ActiveWindow.SmallScroll ToRight:=-1
'Range("a1").Select
End Sub
-----------Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

 

[Hieu]

Re : Code vba plusieurs couleurs

Salut,

Function NbCoul(Zne As Range, Couleur As String)
Application.Volatile True
For Each cell In Zne
    if cell.Interior.ColorIndex = Couleur then  NbCoul = NbCoul + 1
Next cell
End Function

'Création Fonction pour récupérer le numéro couleur de remplissage
Function Couleur(CL As Range) As Long
Couleur = CL.Interior.ColorIndex
End Function

 

[Modeste geedee]

Re : Code vba plusieurs couleurs

Bonsour

Dans le code suivant aux tirets, il détecte nom ambigu je ne vois pas pourquoi? Quelle solution? merci.


End Sub
-----------Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

il ne doit exister qu'une seule proc "Worksheet_SelectionChange(ByVal Target As Range)" par feuille ... !

supprimer la seconde , ajouter le calculate dans la 1ére proc 🙄

 

[laplayast]

Re : Code vba plusieurs couleurs

bonjour,

Nickel 🙂

 

[laplayast]

Re : Code vba plusieurs couleurs

Bonjour,

Autre situation, est-il possible de simplifier la formule dessous et la rendre plus courte, en étant aussi efficace.

Merci.


=NbCoul(G5:G30;43)+NbCoul(G5:G30;3)+NbCoul(G5:G30;6)