Colorier une cellule suite a une condition

Résolu/Fermé
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017 - Modifié par Whismeril le 30/10/2015 à 22:21
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 2 nov. 2015 à 19:50
Bonjour,
Bonjour,

Voici mon code qui me permet de vérifier des champs qui doivent être remplis aussi la vérification d'autres conditions avant qu'il mette un xx dans la cellule 42 si toutes les conditions sont vraies

j'aimerais bien , colorier les cellules qui sont vides après la vérification, j'ai essayé le code ce dessus mais il marche pas vraiment

est ce que vous pourrirez m'aider à trouver mon erreur

merci


  Dim c As Integer
         Dim q As Integer
  Dim MaPlage As Range
            
       For q = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    Set MaPlage = Range("A:H, J:R").Rows(q)
 For Each c In MaPlage
If IsEmpty(c) Then c.Interior.ColorIndex = 3


    If CStr(ActiveSheet.Cells(q, 31).Value) = "Completed - Appointment made / Complété - Nomination faite" _
    And WorksheetFunction.CountIf(MaPlage, "") = 0 Then
        Select Case UCase(ActiveSheet.Cells(q, 14).Value)
            Case "INA_CIN"
              ActiveSheet.Cells(q, 42).Value = "XX"
         End Select
      End If
    

       
Next c
Next q
    



4 réponses

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
31 oct. 2015 à 09:12
Si tu veux aller à la dernière ligne de tes colonnes:

Dim q, q1, q2, q3 As Integer
Dim Col As Range
Dim c As Range
Dim MaPlage As Range
  q = Range("A65536").End(xlUp).Row
  q1 = Range("H65536").End(xlUp).Row
  q2 = Range("J65536").End(xlUp).Row
  q3 = Range("R65536").End(xlUp).Row
  
   Set MaPlage = Range("A1:A" & q & ",H1:H" & q1 & ",J1:J" & q2 & ",R1:R" & q3 & "").Columns

For q = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
       
For Each Col In MaPlage
     For Each c In Col.Cells
    If Len(c.Value) = 0 Then c.Interior.Color = vbYellow
    
    'If CStr(ActiveSheet.Cells(q, 31).Value) = "Completed - Appointment made / Complété - Nomination faite" _
       '  And WorksheetFunction.CountIf(MaPlage, "") = 0 Then
       ' Select Case UCase(ActiveSheet.Cells(q, 14).Value)
          '  Case "INA_CIN"
             '   ActiveSheet.Cells(q, 42).Value = "XX"
        'End Select
   ' End If
    
    Next c
Next Col
Next q

1
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
2 nov. 2015 à 19:15
salut , je l'ai essayé mais j'ai eu une erreur : unable to get the countif property of the worksheetFunction class
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 nov. 2015 à 19:50
Intéresse-toi à cette ligne de code que fait-elle?

ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row


pour le savoir on met ceci:

MsgBox ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row


Tu obtiens la dernière ligne de la colonne A. Tu fais donc une boucle sur toutes tes colonnes, de la ligne 2 à la ligne de la dernière ligne de la colonne A. Donc dans les colonnes qui sont plus remplies que la colonne A , le surplus n'est pas pris en compte.

Il faut donc que tu corriges le code en vert dans l'exemple que je t'ai donné. Moi ma boucle parcourt toutes les colonnes pour mettre la coloration. Tel qu'elle est je n'ai aucun bug.

Je ne sais pas où tu as eu ce code, mais il n'est pas bon!

@+ Le Pivert
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
30 oct. 2015 à 16:34
0
r4944 Messages postés 122 Date d'inscription vendredi 2 octobre 2015 Statut Membre Dernière intervention 3 mars 2017
Modifié par Whismeril le 30/10/2015 à 22:21
salut j'ai reussi a le faire tourner mais le probleme qu'il prend pas toujours en consideration la derniere ligne du tableau c'est bizarre un peu
voici mon code
     Dim g As Integer
         Dim q As Integer
        
             Dim c As Range
   Dim d As Range
  Dim MaPlage As Range
            
       For q = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    
    Set MaPlage = Range("A:H, J:R").Rows(q)
     For Each c In MaPlage.Cells
    If Len(c.Value) = 0 Then c.Interior.Color = vbYellow
    
    If CStr(ActiveSheet.Cells(q, 31).Value) = "Completed - Appointment made / Complété - Nomination faite" _
         And WorksheetFunction.CountIf(MaPlage, "") = 0 Then
        Select Case UCase(ActiveSheet.Cells(q, 14).Value)
            Case "INA_CIN"
                ActiveSheet.Cells(q, 42).Value = "XX"
        End Select
    End If
    
    Next c
Next q
    
0
Whismeril Messages postés 19026 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 20 avril 2024 931
30 oct. 2015 à 22:21
EDIT : Ajout du LANGAGE dans les balises de code.
Explications disponibles ICI

Merci d'y penser dans tes prochains messages.
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
31 oct. 2015 à 07:52
Dim g As Integer
Dim q As Integer
Dim Col As Range
Dim c As Range
Dim d As Range
Dim MaPlage As Range
          
       For q = 2 To Range("R65536").End(xlUp).Row 'dernière ligne, a adapter à la colonne la plus remplie ici la R
    
   ' Set MaPlage = Range("A:H, J:R").Rows(q)
     For Each Col In Range("A1:A" & q & ",H1:H" & q & ",J1:J" & q & ",R1:r" & q & "").Columns ' a adapter
     For Each c In Col.Cells
    If Len(c.Value) = 0 Then c.Interior.Color = vbYellow
    
    'If CStr(ActiveSheet.Cells(q, 31).Value) = "Completed - Appointment made / Complété - Nomination faite" _
       '  And WorksheetFunction.CountIf(MaPlage, "") = 0 Then
       ' Select Case UCase(ActiveSheet.Cells(q, 14).Value)
          '  Case "INA_CIN"
             '   ActiveSheet.Cells(q, 42).Value = "XX"
        'End Select
   ' End If
    
    Next
Next
Next

0