XL 2010 Dupliquer fonction macro a plusieurs cellules

[tourry]

Bonjour à tous,

Je calle pour dupliquer une macro de mon classeur, basé sur 1 cellule, à plusieurs autres cellules.

Actuellement, dans mon classeur, quand la date inscrite dans la cellule K9 de la feuille "Dispo" se retrouve en rouge dans la feuille "Seville" (date en rouge si l'information STOP est écrite), alors la cellule K9 de la feuille "Dispo" passe en rouge.

Maintenant je dois reproduire cette fonction pour les cellules K10 à K20 de la feuille 'Dispo", à savoir :
si la date inscrite dans ma cellule K10 de la feuille "Dispo" se retrouve en rouge dans la feuille "Seville" (date en rouge si l'information STOP existe), alors la cellule K10 de la feuille "Dispo" passe en rouge.

etc, etc, etc ... jusqu'à la cellule K20 de ma feuille "Dispo".

Mais attention, il faut que la colorisation des cellules K9 à K20 en feuille "Dispo" reste indépendante, cellule par cellule, selon les dates en STOP ou pas de la feuille "Seville".

Quelqu'un aurait une idée ?

Merci d'avance

 

[vgendron]

Re : Dupliquer fonction macro a plusieurs cellules

Hello

Essai avec ce code

Sub Kaneuf()

For Each jour In Sheets("Dispo").Range("K9:K16")
    Set c = Sheets("Seville").Range("A6:W36").Find(jour, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        If UCase(c.Offset(0, 1)) = "STOP" Then
            jour.Interior.ColorIndex = 3
        Else
            jour.Interior.ColorIndex = xlNone
        End If
    End If
Next jour
End Sub

 

[tourry]

Re : Dupliquer fonction macro a plusieurs cellules

bonjour vgendron

Excellent !

Alors si je veux en fait que l'ordre ne soit donné qu'aux cellules K9 + K10 + K15 (et non pas de K9 à K15) je peux entrer ça comment ?

D'autre part, je veux que le même ordre parte sur ces cellules si : If UCase(c.Offset(0, 1)) = "STOP" Then
mais également : If UCase(c.Offset(0, 1)) = "RQ" Then
Il faut que j'entre ces 2 conditions, ou/ou mais je n'y arrive pas.

Merci

 

[vgendron]

Re : Dupliquer fonction macro a plusieurs cellules

il faut donc passer par un tableau (array) que tu utilises pour lister les cellules souhaitées
à modifier à la main donc..

et pour le RQ: si j'ai bien compris.. tu colories si la cellule contient STOP OU RQ ??

voici

Sub Kaneuf2()
liste = Array("K9", "K10", "K15")

For i = LBound(liste) To UBound(liste)
    'MsgBox liste(i)
    jour = Sheets("Dispo").Range(liste(i))
    Set c = Sheets("Seville").Range("A6:W36").Find(jour, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        If UCase(c.Offset(0, 1)) = "STOP" Or UCase(c.Offset(0, 1)) = "RQ" Then
            Sheets("Dispo").Range(liste(i)).Interior.ColorIndex = 3
        Else
            Sheets("Dispo").Range(liste(i)).Interior.ColorIndex = xlNone
        End If
    End If
Next i
End Sub

 

[tourry]

Re : Dupliquer fonction macro a plusieurs cellules

en fait si ma cellule contient STOP = rouge
si ma cellule contient RQ = orange

 

[vgendron]

Re : Dupliquer fonction macro a plusieurs cellules

en fait. ce serait bien de donner tous les bons éléments dès le début et pas modifier à chaque fois..

et franchement.. la tu as tous les éléments pour adapter le code toi meme..
mais bon. on est lundi. suis encore de bonne humeur ;-)

Sub Kaneuf3()
liste = Array("K9", "K10", "K15")

For i = LBound(liste) To UBound(liste)
    'MsgBox liste(i)
    jour = Sheets("Dispo").Range(liste(i))
    Set c = Sheets("Seville").Range("A6:W36").Find(jour, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        If UCase(c.Offset(0, 1)) = "STOP" Then
            Sheets("Dispo").Range(liste(i)).Interior.ColorIndex = 3
       ElseIf UCase(c.Offset(0, 1)) = "RQ" Then
            Sheets("Dispo").Range(liste(i)).Interior.ColorIndex = 4 'Trouver le bon indice pour avoir la bonne couleur
        Else
            Sheets("Dispo").Range(liste(i)).Interior.ColorIndex = xlNone
        End If
    End If
Next i
End Sub

 

[tourry]

Re : Dupliquer fonction macro a plusieurs cellules

Merci vgendron 😎
J'ai donc de la chance qu'on soit lundi !! Serais-tu d'humeur bougonne le reste de la semaine ?? 😀

Tu as raison mais n'étant pas du tout calé dans ces paramétrages j'ai du mal à me projeter en expliquant correctement au départ mes besoins...

Ce que tu m'as transmis fonctionne impeccable ! Bravo.

Maintenant je vais continuer pour pouvoir faire la même chose mais avec une feuille supplémentaire et pour les une autre cellules. Si j'ai du mal j'attendrai lundi prochain pour t'appeler au secours 😱😱

Merci encore vgendron ! tu m'a super bien dépanné c'est vraiment chouette

à bientôt