Macro pour mise en forme de cellule en fonction d'un min/max

Bonjour

J'ai un fichier pour lequel je souhaiterai que dans le cas ou la cellule contient une donnée chiffrée celle ci soit comparée avec les données min/max définies pour la ligne. Dans le cas ou la valeur n'est pas dans l'intervalle la cellule est coloriée en rouge (Cel.Interior.ColorIndex = 15).

Ci -dessous mon fichier

Pour être plus précis la zone concerné commence en cellule M37 et finie en AF85 mais avec des lignes à ignorer : 64 à 67 / 71-72 / 76-77/ 81-82.

Les infos de min max se trouvent en colonne K et L. Elles sont spécifiques à chaque ligne.

merci

Bonjour piouk02

Voici la formule à utiliser pour les MFC

=ET(M37<>"";OU(M37<$K37;M37>$L37))

@+

Bonjour

merci pour la réponse.

Mais je voudrais le faire sous forme de macro.

Alors j’essaye de trouver mais pas évident

J'ai trouvé une formule qui me permet de comparer une valeur d'une cellule par rapport aux 2 autres.

Mais je n'arrive pas à créer une boucle qui permette de l'appliquer à chaque ligne de ma zone.

Sub balayge()

If Rows(11).Cells(5) <> "" Then
    If Rows(11).Cells(5) > Rows(11).Cells(2) & Rows(11).Cells(5) < Rows(11).Cells(3) Then
Rows(11).Cells(5).Interior.ColorIndex = 15
End If
End If

Re,

Je pense qu'il vaut mieux passer par des MFC

Il suffit d'utiliser l'enregistreur de macro pour avoir le code de base, il faut ensuite le modifier

@+

Le problème avec une MFC c'est que a la fin je lance une macro qui regarde la couleur de fond des cellules.

Et cela ne marche pas avec les MFC du coup

Je suis arrivé à balayer la 1ere colonne qui m’intéresse :

Sub test4()
For i = 11 To 13 '(nb ligne)
If Range("E" & i) <> "" Then
    If Range("E" & i) > Range("B" & i) & Range("E" & i) < Range("C" & i) Then
    Range("E" & i).Interior.ColorIndex = 9
    End If
End If
Next i

End Sub

Problème la macro se contente de colorer les cellules non vide elle ne compare pas la valeur par rapport aux valeurs des colonnes B et C

Bonjour Piouk02

Voici une possibilité de code qui parcours toutes les lignes de toutes les colonnes par pas de 2

Sub IntervalMinMax()
  Dim Col As Long, dCol As Long
  Dim dLig As Long, Lig As Long
  Dim Sht As Worksheet
  Set Sht = ActiveSheet
  ' Pour chaque colonne
  For Col = Range("M37").Column To Range("AE37").Column Step 2
    ' Pour chaque ligne
    For Lig = 37 To 85
      ' Selon le numéro de la ligne
      Select Case Lig
      Case 64 To 67
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case 71 To 72
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case 76 To 77
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case 81 To 82
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case Else
        ' Eviter les celulles contenant : conforme / Non conforme
        If InStr(1, Sht.Range("K" & Lig), "conforme", vbTextCompare) > 0 Then GoTo SuiteLig
        ' Eviter les cellules vide
        If Sht.Cells(Lig, Col) = "" Then GoTo SuiteLig
        ' Evaleuer la valeur avec min/max
        If Sht.Cells(Lig, Col) < Sht.Range("K" & Lig) Or Sht.Cells(Lig, Col) > Sht.Range("L" & Lig) Then
          ' Valeur ne rentre pas entre le min et le max = couleur rouge
          Sht.Cells(Lig, Col).Interior.Color = 255
        Else
          ' Valeur OK, mettre la couleur saumon
          Sht.Cells(Lig, Col).Interior.Color = 14281213
        End If
      End Select
SuiteLig:
    Next Lig
  Next Col
End Sub

@+

Bonjour BrunoM45,

Merci pour le code j'en était très loin.

Cela fonctionne j'ai juste du changer le K en L dans la formule après le >

If Sht.Cells(Lig, Col) < Sht.Range("K" & Lig) Or Sht.Cells(Lig, Col) > Sht.Range("L" & Lig) Then

et modifier la ligne qui ignore les types "conformités" :

If InStr(1, Sht.Range("J" & Lig), "Conforme / Non conforme", vbTextCompare) > 0 Then GoTo SuiteLig

Par contre la mise en forme ne s'applique pas pour les lignes 68-69-70/ 73-74-75 / 78-79-80 et je n'ai pas trouvé pourquoi.

Re,

Effectivement le 2ème test est à faire sur la colonne "L", en revanche pour "conforme", dans le fichier donné,
il y a une valeur dans la colonne K pour les lignes 58, 60 et 62, c'est pour cela que j'ai mis le test, sinon il ne sert à rien

Ensuite pour les dernière lignes, c'est logique avec toutes ces cellules fusionnées

Je teste le min et le max de la ligne parcouru, donc K68 et L68, puis K69 et L69, etc..
Voici le code modifié pour tester la bonne ligne à partir de la ligne 68

Sub IntervalMinMax()
  Dim Col As Long, dCol As Long
  Dim dLig As Long, Lig As Long
  Dim Sht As Worksheet
  Set Sht = ActiveSheet
  ' Pour chaque colonne
  For Col = Range("M37").Column To Range("AE37").Column Step 2
    ' Pour chaque ligne
    For Lig = 37 To 85
      If Lig = 68 Then Stop
      ' Eviter les cellules vide
      If Sht.Cells(Lig, Col) = "" Then GoTo SuiteLig
      ' Eviter les celulles contenant : conforme / Non conforme (lignes58, 60 et 62)
      If InStr(1, Sht.Range("K" & Lig), "conforme", vbTextCompare) > 0 Then GoTo SuiteLig
      ' Selon le numéro de la ligne
      Select Case Lig
      Case 64 To 67
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case 68 To 70 ' Ok pour le test de la ligne 68
        ' Evaluer la valeur avec min/max
        If Sht.Cells(Lig, Col) < Sht.Range("K68") Or Sht.Cells(Lig, Col) > Sht.Range("L68") Then
          ' Valeur ne rentre pas entre le min et le max = couleur rouge
          Sht.Cells(Lig, Col).Interior.Color = 255
        Else
          ' Valeur OK, mettre la couleur saumon
          Sht.Cells(Lig, Col).Interior.Color = 14281213
        End If
      Case 71 To 72
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case 73 To 75 ' Ok pour le test de la ligne 73
        ' Evaluer la valeur avec min/max
        If Sht.Cells(Lig, Col) < Sht.Range("K73") Or Sht.Cells(Lig, Col) > Sht.Range("L73") Then
          ' Valeur ne rentre pas entre le min et le max = couleur rouge
          Sht.Cells(Lig, Col).Interior.Color = 255
        Else
          ' Valeur OK, mettre la couleur saumon
          Sht.Cells(Lig, Col).Interior.Color = 14281213
        End If
      Case 76 To 77
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case 78 To 80 ' Ok pour le test de la ligne 78
        ' Evaluer la valeur avec min/max
        If Sht.Cells(Lig, Col) < Sht.Range("K78") Or Sht.Cells(Lig, Col) > Sht.Range("L78") Then
          ' Valeur ne rentre pas entre le min et le max = couleur rouge
          Sht.Cells(Lig, Col).Interior.Color = 255
        Else
          ' Valeur OK, mettre la couleur saumon
          Sht.Cells(Lig, Col).Interior.Color = 14281213
        End If
      Case 81 To 82
        Application.StatusBar = "Ligne [" & Lig & "] ignorée"
      Case 83 To 85 ' Ok pour le test de la ligne 83
        ' Evaluer la valeur avec min/max
        If Sht.Cells(Lig, Col) < Sht.Range("K83") Or Sht.Cells(Lig, Col) > Sht.Range("L83") Then
          ' Valeur ne rentre pas entre le min et le max = couleur rouge
          Sht.Cells(Lig, Col).Interior.Color = 255
        Else
          ' Valeur OK, mettre la couleur saumon
          Sht.Cells(Lig, Col).Interior.Color = 14281213
        End If
      Case Else
        ' Evaluer la valeur avec min/max
        If Sht.Cells(Lig, Col) < Sht.Range("K" & Lig) Or Sht.Cells(Lig, Col) > Sht.Range("L" & Lig) Then
          ' Valeur ne rentre pas entre le min et le max = couleur rouge
          Sht.Cells(Lig, Col).Interior.Color = 255
        Else
          ' Valeur OK, mettre la couleur saumon
          Sht.Cells(Lig, Col).Interior.Color = 14281213
        End If
      End Select
SuiteLig:
    Next Lig
  Next Col
End Sub

Par contre pour ces lignes tu as une MFC qui colore en gris les cellules non vide, donc tu ne peux pas voir la couleur

Si tu supprimes cette MFC, c'est bon

@+

RE

Grand merci BrunoM45.

tout fonctionne à merveille.