XL 2016 macros et MFC lentes

halecs93

XLDnaute Impliqué
Bonjour,

J'ai "bricolé" quelques formules sur ma feuille excel.

Il s'agit de colorer des cellules en fonction de leur contenu et/ou d'automatiser un contenu en fonction de leur couleur.

J'ai l'impression que les temps de calcul sont extrêmement longs.

Peut-être une autre approche ?

Un grand merci
 

Pièces jointes

  • Planning Orientation Bâtiment exceldownloads.xlsm
    39.2 KB · Affichages: 5

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Il n'y a qu'une seule MFC dans ta feuille. C'est bien ça ?

La formule de cette MFC est actuellement :
Code:
=(JOURSEM(DECALER(A5;;-(MOD(COLONNE()-1;32)));2)>5)*(DECALER(A5;;-(MOD(COLONNE()-1;32)))<>"")
Elle est censée faire quoi ? Juste colorier les samedis et dimanches ?

Si c'est ça, alors cette formule devrait également convenir :
Code:
=JOURSEM($A5;2)>5
 
Dernière édition:

halecs93

XLDnaute Impliqué
Bonjour,

Il n'y a qu'une seule MFC dans ta feuille. C'est bien ça ?

La formule de cette MFC est actuellement :
Code:
=(JOURSEM(DECALER(A5;;-(MOD(COLONNE()-1;32)));2)>5)*(DECALER(A5;;-(MOD(COLONNE()-1;32)))<>"")
Elle est censée faire quoi ? Juste colorier les samedis et dimanches ?

Si c'est ça, alors cette formule devrait également convenir :
Code:
=JOURSEM($A5;2)>5
Oui...totalement... malgré tout, lorsque j'applique une couleur sur une ou plusieurs cellules, le calcul me semble encore long pour voir s'y inscrire MB ou autre...
 

TooFatBoy

XLDnaute Barbatruc
A chaque fois qu'on change la "sélection", tu réécrits le contenu de toutes les cellules dont le fond est colorié ?!? :oops:
Ce qui en plus appelle, à chaque écriture, la macro Worksheet_Change ! :eek:
 
Dernière édition:

halecs93

XLDnaute Impliqué
Donc tu veux colorier et qu'en fonction de la couleur ça écrive le texte ?
J'avoue ne pas être sûr de la clarté de mes propos ;)

1710353161505.png
 

TooFatBoy

XLDnaute Barbatruc
Pour moi, si tu veux faire une boucle (pas sûr que ce soit bien utile) For Each cell In Plage, il faut d'abord faire un Set plage = Intersect(Target, Me.Range("C5:Y35")).

Mais si je pige bien :
- soit tu colores en jaune et ça écrit "MB",
- soit tu mets "MB" et ça colore en jaune.
 

halecs93

XLDnaute Impliqué
Pour moi, si tu veux faire une boucle (pas sûr que ce soit bien utile) For Each cell In Plage, il faut d'abord faire un Set plage = Intersect(Target, Me.Range("C5:Y35")).

Mais si je pige bien :
- soit tu colores en jaune et ça écrit "MB",
- soit tu mets "MB" et ça colore en jaune.
tout à fait...et si je supprime le contenu d'une cellule, ça efface la couleur
 

TooFatBoy

XLDnaute Barbatruc
Peut-être ça :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim plage As Range, cell As Range

    ' Définir la plage de cellules à surveiller sur la feuille active
    Set plage = Intersect(Target, Me.Range("C5:Y35"))

    ' Vérifier si la plage de cellules sélectionnée est dans la plage spécifiée
    If plage Is Nothing Then Exit Sub

    Application.EnableEvents = False

    ' Parcourir chaque cellule de la plage
    For Each cell In plage
        Select Case cell.Interior.Color
        Case RGB(255, 255, 0)   ' Jaune
            cell.Value = "MB"
        Case RGB(146, 208, 80)  ' Vert
            cell.Value = "RG"
        Case RGB(0, 176, 240)   ' Bleu
            cell.Value = "SP"
        Case RGB(247, 150, 70)  ' Orange
            cell.Value = "SC"
        Case RGB(218, 150, 148) ' Chaire
            cell.Value = "MN"
        Case RGB(192, 0, 0)     ' Rouge 1
            cell.Value = "MG"
        Case RGB(150, 54, 52)   ' Rouge 2
            cell.Value = "MP"
        End Select
    Next cell

    Application.EnableEvents = True

End Sub

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim plage As Range, cell As Range

    ' Définir la plage de cellules à surveiller sur la feuille active
    Set plage = Intersect(Target, Me.Range("C5:Y35"))

    ' Vérifier si les cellules modifiées sont dans la plage spécifiée
    If plage Is Nothing Then Exit Sub

    Application.EnableEvents = False ' Désactiver temporairement les événements pour éviter une boucle infinie

    ' Parcourir chaque cellule modifiée
    For Each cell In plage
        ' Si la cellule est maintenant vide, effacer la couleur de fond
        If cell.Value = "" Then
            cell.Interior.ColorIndex = xlNone
        Else
            ' Mettre à jour la couleur de fond en fonction de la valeur de la cellule
            Select Case cell.Value
            Case "MB"
                cell.Interior.Color = RGB(255, 255, 0) ' Jaune
            Case "RG"
                cell.Interior.Color = RGB(146, 208, 80) ' Vert
            Case "SP"
                cell.Interior.Color = RGB(0, 176, 240) ' Bleu
            Case "SC"
                cell.Interior.Color = RGB(247, 150, 70) ' Orange
            Case "MN"
                cell.Interior.Color = RGB(218, 150, 148) ' Chaire
            Case "MG"
                cell.Interior.Color = RGB(192, 0, 0) ' Rouge
            Case "MP"
                cell.Interior.Color = RGB(150, 54, 52) ' Rouge_2
            Case Else
                ' Réinitialiser la couleur de fond si la valeur n'est pas reconnue
                cell.Interior.ColorIndex = xlNone
            End Select
        End If
    Next cell

    Application.EnableEvents = True ' Réactiver les événements

End Sub
 

Discussions similaires

Réponses
34
Affichages
724

Statistiques des forums

Discussions
313 263
Messages
2 096 655
Membres
106 701
dernier inscrit
KOFFI