Comparer deux cellules
Bonjour,
Comme dit, démultiplier les MEFC et test n'est pas forcément la bonne pratique car une MEFC est tout de même calculée au même titre qu'une formule.
Par exemple ces MEFC pourraient être condensées en une seule comme elle concernent la même plage :
With Range(.Cells(2, 10), .Cells(LR, 11))
.FormatConditions.Add xlExpression, , "=ET($J2<>"""";ET($K2<$J2))"
.FormatConditions.Add xlExpression, , "=ET($K2<>"""";ET($J2=""""))"
.FormatConditions(1).Interior.COLOR = 7697919
.FormatConditions(2).Interior.COLOR = 7697919
End With
Idem ici :
For L = 2 To LR
pr = .Cells(L, 1) & .Cells(L, 2) & .Cells(L, 3) & .Cells(L, 4)
npr = .Cells(L + 1, 1) & .Cells(L + 1, 2) & .Cells(L + 1, 3) & .Cells(L + 1, 4)
If npr = pr Then
If .Cells(L + 1, 5) - 1 <> .Cells(L, 6) Then
ERREUR = True
End If
End If
Autant dire que après ERREUR = True on passe sort de la boucle, voir ajouter un GoTo GESTION_ERREUR en adaptant le code pour faire appliquer la MEFC : Il est évident qu'à la première erreur rencontrée on va vouloir appliquer la MEFC même s'il en existe 2. Ca évite de boucler inutilement et de perdre du temps d’exécution.
Cdlt,
Ergotamine,
Comment on fait dans ce cas là ? J'avoue ne pas maîtriser cette partie
Merci à toi !
Cordialement,
Bonjour,
Surement encore optimisation mais je commence à m'y perdre avec toutes ces exceptions/conditions :
Sub verifier_finitions()
Dim ERREUR As Boolean, L%, i%, LR%, W%
Dim pr As String
Dim npr As String
With Sheets("Modèle")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
For W = 2 To LR
.Cells(W, 4) = UCase(SupprimerAccents(.Cells(W, 4)))
Next W
For L = 2 To LR
pr = .Cells(L, 1) & .Cells(L, 2) & .Cells(L, 3) & .Cells(L, 4)
npr = .Cells(L + 1, 1) & .Cells(L + 1, 2) & .Cells(L + 1, 3) & .Cells(L + 1, 4)
If npr = pr Then
If .Cells(L + 1, 5) - 1 <> .Cells(L, 6) Then
ERREUR = True
GoTo GEST_ERREUR
End If
End If
For i = 2 To 9
If .Cells(L, i) = "" Or _
.Cells(L, 10) <> "" And .Cells(L, 10) < .Cells(L, 8) Or _
.Cells(L, 10) <> "" And .Cells(L, 11) = "" Or _
.Cells(L, 11) <> "" And .Cells(L, 11) < .Cells(L, 10) Or _
.Cells(L, 11) <> "" And .Cells(L, 10) = "" Or _
.Cells(L, 4) = .Cells(L, 1) Then
ERREUR = True
GoTo GEST_ERREUR
End If
Next i
Next L
GEST_ERREUR:
If ERREUR = True Then
.Unprotect "MDP"
If .Cells.FormatConditions.Count > 0 Then
.Cells.FormatConditions.Delete
End If
With Range(.Cells(2, 2), .Cells(LR, 9))
.FormatConditions.Add xlExpression, , "=ET($A2<>"""";OU(B2="""";ET(COLONNE(B2)=10;B2<$H2);ET(COLONNE(B2)=4;B2=$A2)))"
.FormatConditions(1).Interior.COLOR = 7697919
End With
With Range(.Cells(3, 5), .Cells(LR, 5))
.FormatConditions.Add xlExpression, , "=ET($A2<>"""";ET($A2=$A3;ET($B2=$B3;ET($C2=$C3;ET($D2=$D3;ET(OU($F2=$E3;OU($F2>$E3;OU($E3<>$F2+1)))))))))"
.FormatConditions(2).Interior.COLOR = 7697919
End With
With Range(.Cells(2, 10), .Cells(LR, 11))
.FormatConditions.Add xlExpression, , "=OU($K2="""";$J2="""";$K2<$J2)"
.FormatConditions(1).Interior.COLOR = 7697919
End With
MsgBox "LES CELLULES SURLIGNEES NE SONT PAS VALIDES", vbCritical, "CELLULES ATTENDANT DES VALEURS"
.Protect "MDP"
Else
MsgBox "LA VALIDATION EST CONFORME", vbInformation
Worksheets("Dimensions").Visible = xlSheetVisible
End If
End With
End Sub
Cdlt,
Bonjour Ergotamine,
Merci beaucoup pour ta réponse :)
Je vais étudier ça du coup !
Bonne journée et bon courage