Microsoft 365 Colorier la cellule de la colonne A si une cellule de la ligne est coloriée

DanB34

XLDnaute Nouveau
Bonjour à tous,
J'utilise une procédure qui repère les cellules vides parmi des colonnes non contigües alors qu'elles doivent obligatoirement être renseignées.
Lorsque ces cellules sont trouvées, elles sont mises en couleur (orange) afin de les repérer et en même temps, les cellules correspondant aux lignes en erreur de la colonne "A" doivent elles aussi être mises en couleur afin de pouvoir filtrer par couleur sur la colonne "A" et de n'afficher que les lignes concernées.
J'utilise actuellement une procédure qui fonctionne, mais qui est lente, car elle effectue la recherche cellule par cellule sur les colonnes identifiées.
J'ai commencé à modifier une macro récupérée et qui va beaucoup plus vite pour mettre en couleur les cellules vides, mais je ne parviens pas à ajouter les cellules de la colonne "A" pour permettre d'utiliser le filtre.
Si nécessaire, j'ajouterai un fichier exemple.
Merci d'avance pour vos propositions.
Bonne soirée
Dan

VB:
Sub Selection_Cellules_Vides()
   Dim plage As Range
   Dim FD As Worksheet
   Dim plageCellules As Range, plageFD As Range
   Dim Cel As Range
   Dim LigDer As Long
      
    Set FD = Sheets("Donnees_SINP")
    LigDer = FD.Range("B999000").End(xlUp).Row
    'Compte les cellules vides
    NbCelVides = Range("B13:F" & LigDer & "," & "H13:H" & LigDer & "," & "BJ13:BJ" & LigDer & "," & "BL13:BL" & LigDer & "," & "BN13:BN" & LigDer & "," & "BP13:BP" & LigDer & "," & "BX13:BX" & LigDer & "," & "CG13:CG" & LigDer & "," & "CM13:CM" & LigDer).SpecialCells(xlCellTypeBlanks).Count
    Set plageFD = FD.Range("B13:F" & LigDer & "," & "H13:H" & LigDer & "," & "BJ13:BJ" & LigDer & "," & "BL13:BL" & LigDer & "," & "BN13:BN" & LigDer & "," & "BP13:BP" & LigDer & "," & "BX13:BX" & LigDer & "," & "CG13:CG" & LigDer & "," & "CM13:CM" & LigDer)
    
    For Each Cel In plageFD.Cells
        If IsEmpty(Cel) Then Set plageCellules = Cel
    Next Cel
    
    For Each Cel In plageFD.Cells
        If IsEmpty(Cel) Then Set plageCellules = Union(plageCellules, Cel)
    Next Cel
    
    plageCellules.Select
    ' Ajout d'une couleur orange dans chacune des cases vides ou non conformes
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
 
Solution
Bonjour,
Et ça ?
VB:
Sub Selection_Cellules_Vides()
   Dim plage As Range
   Dim FD As Worksheet
   Dim plageCellules As Range, plageFD As Range
   Dim Cel As Range
   Dim LigDer As Long
   Dim NbCelVides As Long
      
    Set FD = ThisWorkbook.Worksheets("Donnees_SINP")
    LigDer = FD.Cells(Rows.Count, "B").End(xlUp).Row
    
    'Compte les cellules vides
    Set plageFD = FD.Range("B13:F" & LigDer & "," & "H13:H" & LigDer & "," & "BJ13:BJ" & LigDer & "," & "BL13:BL" & LigDer & "," & "BN13:BN" & LigDer & "," & "BP13:BP" & LigDer & "," & "BX13:BX" & LigDer & "," & "CG13:CG" & LigDer & "," & "CM13:CM" & LigDer)
    NbCelVides = plageFD.SpecialCells(xlCellTypeBlanks).Count

    For Each Cel In plageFD.Cells
        If IsEmpty(Cel) Then...

Dudu2

XLDnaute Barbatruc
Bonjour,
Et ça ?
VB:
Sub Selection_Cellules_Vides()
   Dim plage As Range
   Dim FD As Worksheet
   Dim plageCellules As Range, plageFD As Range
   Dim Cel As Range
   Dim LigDer As Long
   Dim NbCelVides As Long
      
    Set FD = ThisWorkbook.Worksheets("Donnees_SINP")
    LigDer = FD.Cells(Rows.Count, "B").End(xlUp).Row
    
    'Compte les cellules vides
    Set plageFD = FD.Range("B13:F" & LigDer & "," & "H13:H" & LigDer & "," & "BJ13:BJ" & LigDer & "," & "BL13:BL" & LigDer & "," & "BN13:BN" & LigDer & "," & "BP13:BP" & LigDer & "," & "BX13:BX" & LigDer & "," & "CG13:CG" & LigDer & "," & "CM13:CM" & LigDer)
    NbCelVides = plageFD.SpecialCells(xlCellTypeBlanks).Count

    For Each Cel In plageFD.Cells
        If IsEmpty(Cel) Then
            If plageCellules Is Nothing Then
                Set plageCellules = Cel
            Else
                Set plageCellules = Union(plageCellules, Cel)
            End If
            Set plageCellules = Union(plageCellules, FD.Cells(Cel.Row, 1))
        End If
    Next Cel
    
    
    If Not plageCellules Is Nothing Then
        ' Ajout d'une couleur orange dans chacune des cases vides ou non conformes
        With plageCellules.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent4
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
End Sub
 

Discussions similaires

Réponses
5
Affichages
616

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla