Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

coloriage (vba?)

OlivGM

XLDnaute Occasionnel
Bonsoir,

Je voudrais colorier mon tableau tel que montré dans mon petit exemple joint.
Il y a environ 500 lignes pour info.

Merci et bonne soirée
 

Pièces jointes

  • Classeu1.xlsx
    58.5 KB · Affichages: 55

eriiic

XLDnaute Barbatruc
Bonjour,

met ta couleur d'extrémités voulue en BF1 et :
VB:
Sub colore()
    Dim pl As Range, pl2 As Range, lig As Long
    Dim nbMin As Long, coul1 As Long, coul2 As Long
    nbMin = [BE1]: coul1 = [BE1].Interior.Color: coul2 = [BF1].Interior.Color
    For lig = 2 To 379
        Set pl = Cells(lig, 7).Resize(, 49).SpecialCells(xlCellTypeBlanks)
        If Not pl Is Nothing Then
            For Each pl2 In pl.Areas
                If pl2.Count >= nbMin Then pl2.Interior.Color = coul1
                If pl2.Column = 7 Then pl2.Interior.Color = coul2
                If pl2.Column + pl2.Count - 1 = 55 Then pl2.Interior.Color = coul2
            Next pl2
        End If
    Next lig
End Sub
eric
 

kingfadhel

XLDnaute Impliqué


Bonsoir,
Rien à dire, c'est excellent.

voilà ce que j'ai commencé à faire mais après avoir vu le code d' @eriiiic

VB:
Sub Mise_en_forme()
For k = 4 To 4
    For l = 55 To 7 Step -1
        Var = 0
        If Not IsEmpty(Cells(k, l)) Then
        Var = Var + 1
        End If
        If Var <> 0 Then
        GoTo suite2
        End If
    Next l
suite2:
Range(Cells(k, 55), Cells(k, l + 1)).Interior.Color = RGB(197, 217, 241)
Next k
For j = 4 To 4
    For i = 7 To 55
        Var = 0
        If Not IsEmpty(Cells(j, i)) Then
        Var = Var + 1
        End If
        If Var <> 0 Then
        GoTo suite
        End If
    Next i
suite:
Range(Cells(j, 7), Cells(j, i - 1)).Interior.Color = RGB(197, 217, 241)
Next j
End Sub

code seulement pour les couleurs d'extrémités.
 

OlivGM

XLDnaute Occasionnel
Bonjour,

Merci pour vos 2 macros:
Sur la macro d'Eric j'ai un bug ici: Set pl = Cells(lig, 7).Resize(, 49).SpecialCells(xlCellTypeBlanks)
et sur la macro de Kingfadhel le haut du tableau se colore mal? (voir fichier)

Merci
 

Pièces jointes

  • essai.xlsm
    64 KB · Affichages: 31

eriiic

XLDnaute Barbatruc
Bonjour,

parce que tu n'as aucune cellule vide, il y a des espaces.
Ce n'est pas parce qu'on ne les voit pas qu'ils ne comptent pas.
Supprime tes espaces et remplace la ligne par :
VB:
        On Error Resume Next
        Set pl = Cells(lig, 7).Resize(, 49).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
eric
 

OlivGM

XLDnaute Occasionnel
Bonjour,

Est-il possible que la macro supprime les espaces?
Toutefois, chaque cellule est une formule SI....valeur, sinon "" donc est-il plutôt possible de modifier la macro en testant si c'est un caractère alphanumérique plutôt qu'une cellule vide?
Sinon je vais devoir reécrire la formule à chaque fois qu'elle aura été effacée.

Merci
Bon samedi.
 

eriiic

XLDnaute Barbatruc
Bonjour,

une cellule avec une formule n'est pas une cellule vide.
Donc ma technique avec .SpecialCells(xlCellTypeBlanks) ne peut pas fonctionner dans ce cas.
Il faut donc balayer toutes les cellules comme le faisait kingfadhel.
eric
 

Discussions similaires

  • Question
XL pour MAC mise en forme
Réponses
2
Affichages
266
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…