Comparer deux cellules
Bonjour tout le monde,
Je suis un peu perdu et je ne comprends pas où est mon erreur dans mon code suivant :
If Cells(a, 10) <> "" Then
If Not IsNumeric(Cells(a, 10).Value) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
If Cells(a, 10).Value <= Cells(a, 7).Value Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique supérieur au prix au m2 actuel pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
End If
End If
End If
Le problème vient de la partie :
If Cells(a, 10).Value <= Cells(a, 7).Value Then
Ce bout de code ne fonctionne pas lorsque je met une valeur de 100 dans ma cellule de la colonne 7 et 10 dans ma cellule de la colonne 10, j'ai quand même une validation comme si tout était ok ... je m'en tire les cheveux car ça paraît pourtant simple mais apparemment non ..
Merci d'avance à vous et bonne journée,
Cordialement,
J'ai je pense trouvé un bout de solution avec :
If Cells(a, 10) <> "" Then
If Not IsNumeric(Cells(a, 10).Value) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
ElseIf (Cells(a, 10).Value) <= (Cells(a, 7).Value) Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique supérieur au prix au m2 actuel pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
End If
End If
Problème lorsque je met le même nombre dans les deux colonnes j'obtiens le message d'erreur dans ma message box ... pourtant j'utilise bien le signe "<=" comment faire ?
Bonjour,
Si vous n'invoquez pas de MsgBox avec liste_erreur vous ne risquez pas de le voir apparaître ;). Ci-joint votre code modifié. Le premier test conditionnel a été modifié pour tout raccourci, je test si c'est vide et dans ce cas je sors. C'est plus simple que de tester si c'est plein :
Sub TEST()
Dim a%, liste_erreurs$
With Worksheets("Feuil1")
If .Cells(a, 10) = "" Then Exit Sub
If Not IsNumeric(.Cells(a, 10)) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
MsgBox liste_erreurs
Exit Sub
End If
If .Cells(a, 10).Value <= .Cells(a, 7).Value Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique supérieur au prix au m2 actuel pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
MsgBox liste_erreurs
End If
End With
End Sub
Cdlt,
Hello Ergotamine,
Oui en vrai j'ai la MsgBox mais c'est parce que mon code est très long :
Sub verifier_finitions()
Dim a As Long
Sheets("Modèle").Activate
liste_erreurs = "Votre fichier comporte des erreurs :"
If Range("D2").Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Saisir au moins un modèle"
End If
For a = 2 To 1000
If Cells(a, 1).Value <> "" Then
If Cells(a, 2).Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez sélectionner au moins une épaisseur valide sur la ligne" & " " & a
End If
If Cells(a, 3).Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez sélectionner au moins une forme valide sur la ligne" & " " & a
End If
If Cells(a, 4).Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer un modèle sur la ligne" & " " & a
End If
If Cells(a, 5).Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez au moins rentrer une donnée pour le A min/profondeur min/diamètre min sur la ligne" & " " & a
Else
If Not IsNumeric(Cells(a, 5).Value) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le A min/profondeur min/diamètre min sur la ligne" & " " & a
End If
End If
If Cells(a, 6).Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez au moins rentrer une donnée pour le A max/profondeur max/diamètre max sur la ligne" & " " & a
Else
If Not IsNumeric(Cells(a, 6).Value) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le A max/profondeur max/diamètre max sur la ligne" & " " & a
End If
End If
If Cells(a, 7).Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée pour le prix au m2 actuel sur la ligne" & " " & a
Else
If Not IsNumeric(Cells(a, 7).Value) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le prix au m2 actuel sur la ligne" & " " & a
End If
End If
If Cells(a, 9).Value = "" Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée pour le min de facturation en m2 sur la ligne" & " " & a
Else
If Not IsNumeric(Cells(a, 9).Value) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le min de facturation en m2 sur la ligne" & " " & a
End If
End If
' If Cells(a, 8) <> "" Then
' If Not IsNumeric(Cells(a, 8).Value) = True Then
' liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le prix au m2 futur sur la ligne" & " " & a
' End If
' End If
If Cells(a, 10) <> "" Then
If Not IsNumeric(Cells(a, 10).Value) = True Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
ElseIf Cells(a, 10) <= Cells(a, 7) Then
liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique supérieur au prix au m2 actuel pour le prix au m2 recto/verso actuel sur la ligne" & " " & a
End If
End If
' If Cells(a, 11) <> "" Then
' If Not IsNumeric(Cells(a, 11).Value) = True Then
' liste_erreurs = liste_erreurs & vbCrLf & "- Veuillez rentrer une donnée numérique pour le prix au m2 recto/verso futur sur la ligne" & " " & a
' End If
' End If
End If
Next a
If liste_erreurs = "Votre fichier comporte des erreurs :" Then
MsgBox ("OK")
Sheets("Dimensions").Visible = xlSheetVisible
Else
MsgBox (liste_erreurs)
End If
End Sub
L'Exit Sub ne me permettra pas du coup de continuer toutes mes vérifications si ?
Sais-tu pourquoi le "<=" ne me donne pas le bon Message ("Ok") alors que je mets bien la même valeur dans mes deux colonnes 7 et 10 .. :/
Merci d'avance à toi !
Bonjour,
En effet le Exit Sub sortira directement de la macro. Mais à quoi bon poursuivre si une des valeurs n'est pas renseigné à part allonger le temps d’exécution ?
Pour votre histoire de <= je ne comprend pas bien .. La macro se comporte exactement comme vous lui demandez. Si en G3 j'ai 100 et J3 j'ai 100 alors G3 est bien inférieur ou égal à J3 donc le MsgBox apparaît. Si vous ne souhaitez qu'il n’apparaissent qu'en cas de valeur inférieure alors il faut utiliser < et non <=.
Ou sinon il y a quelque chose que je n'ai pas compris, mais je ne vois pas d'incohérence entre le code et le résultat. Sinon il faudra détailler le résultat attendu.
Cdlt,
Ce fichier est à destination de l'extérieur, le but c'est de permettre à la personne qui remplie le fichier de voir où elle a potentiellement fait des erreurs, avant de pouvoir passer sur l'onglet suivant, les données envoyées sont intégrées dans notre SI et nous voulons déjà une première vérification en évitant des erreurs d'inattention :)
Pour l'histoire du J3 et G3 lorsque je met la même valeur de mon côté la MsgBox qui apparaît me dit que la valeur doit être supérieur et non pas "OK" donc il y a bien un soucis car je met la même valeur il devrait me dire que c'est bon ce qui n'est pas le cas :/
Exemple :
Le souhaité :
J3 = 100
G3 = 100
MsgBox = OK
Actuellement :
J3 = 100
G3 = 100
MsgBox = "Veuillez rentrer une donnée numérique supérieur au prix au m2 actuel pour la colonne du prix au m2 recto/verso actuel sur la ligne x"
Je sais pas si j'ai réussis à mieux retranscrire le problème :)
Merci d'avance !
Bonjour,
Comme je vous ai expliqué c'est votre coding qui ne va pas. Essayez :
ElseIf Cells(a, 10) < Cells(a, 7) Then
Et dites moi ce que vous obtenez.
Cdlt,
Punaise j'y crois pas ... Je me suis lancé tête baissé à me dire qu'il fallait le "<=" et je comprenais vraiment pas le soucis ... En fait, c'est juste que j'ai juste très mal relu mon code en ne me disant pas que si c'était vrai alors c'était une erreur U_u
Bien vue, merci à toi pour le coup de pouce et de m'avoir pointé du doigt l'erreur et mon entêtement
J'aurais une autre question pour toi, penses-tu que je puisses réduire mes lignes de code tout en gardant le même sens ou cela semble ok ?
J'ai du ajouter une fonction passage majuscule et suppression d'accent ce qui fait que mon code prend désormais pas mal de temps à l'exécution mais pour le coup
Function SupprimerAccents(ByVal sChaine As String) As String
Dim sTmp As String, i As Long, p As Long
Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
sTmp = sChaine
For i = 1 To Len(sTmp)
p = InStr(sCarAccent, Mid(sTmp, i, 1))
If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
Next i
SupprimerAccents = sTmp
End Function
Cells(a, 4).Value = UCase(Cells(a, 4)): Cells(a, 4).Value = SupprimerAccents(Cells(a, 4))
Je me demande si au lieu de le faire au clic du bouton je ne ferais pas gagner du temps en lançant à chaque changement dans la colonne en question tu en penses quoi ?
Merci encore à toi !
Bonjour,
Pas certain que vous alliez apprécier mais je tente quand même. Ci-contre comment je verrais votre code version allegée. Attention non testé car je n'ai pas de fichier représentatif sous la main ! :
Sub verifier_finitions()
Dim a As Long
Dim C() As Long
Dim ERREUR$
C = Array(2, 3, 4, 5, 6, 7, 9)
With Sheets("Modèle")
If .[D2] = "" Then ERREUR = "D2"
For a = 2 To 1000
If .Cells(a, 1).Value = "" Then Next a
For I = 0 To UBound(C)
If .Cells(a, C(I)).Value = "" Then
ERREUR = ERREUR & .Cells(a, C(I)).Address
End If
Next I
Next a
End With
If ERREUR <> "" Then
MsgBox ERREUR, vbCritical, "CELLULES ATTENDANT DES VALEURS"
Else
Worksheets("Dimensions").Visible = xlSheetVisible
End If
End Sub
En effet, si la première valeur est vide alors je ne test rien, je passe directement au cas d'après, ça ne sert à rien de le vérifier.
Ensuite je boucle sur les colonnes attendant des valeurs, s'il n'y en a pas j’inscris leur adresse dans le message ERREUR.
Pour ce qui est des valeurs numériques, ou des comparaisons entre les valeurs, préférez les listes de validations au code VBA, c'est une fonctionnalité native d'EXCEL, autant s'en servir pour éviter d’alourdir du code :
Pour la fonction personnalisée je vous conseille de ne la lancer que lorsqu'une valeur est renseignée. Il faut que vous vous demandiez, pourquoi ais-je besoin de supprimer les accents ?
Vu le nombre de ligne, autant passer sur une table structurée si ce n'est pas déjà fait afin que les listes de validation et format se répliquent systématiquement.
Cdlt,
PS : Je ne pourrais pas faire de débogage sans fichier désolé, il faudra adapter le code par vous même si vous ne souhaitez pas le joindre.
Pour ce qui est des valeurs numériques, ou des comparaisons entre les valeurs, préférez les listes de validations au code VBA, c'est une fonctionnalité native d'EXCEL, autant s'en servir pour éviter d’alourdir du code :
J'avoue que je ne savais pas pour cette partie, je me suis lancé dans le code de suite en me disant que c'était la seule solution
Pour la fonction personnalisée je vous conseille de ne la lancer que lorsqu'une valeur est renseignée. Il faut que vous vous demandiez, pourquoi ais-je besoin de supprimer les accents ?
Comment procéder de cette façon avec le fameux : worksheet_change(byval target as range) ?
Pour le fichier ce n'est pas que je ne veux pas le donner, c'est qu'il faut que j'essaie de retirer le plus possible de données si je veux le mettre
Je vais essayer aussi de comprendre votre code, beaucoup plus court effectivement, après en soit à part le fait de supprimer les accents je trouve que le code est assez rapide dans son exécution mais si on peut encore faire mieux et plus simple pourquoi pas
Merci encore à vous,
Et je vais voir pour mettre le fichier au plus vite ;)
Voici mon fichier
Merci de votre aide en tout cas !
EDIT : L'onglet dont on parle c'est "Modèle"
Bonjour,
Avant tout, comme je l'ai expliqué, quel est le but d'harmoniser ces données sans accents ? Quelle est l'analyse à réaliser derrière ? Sur quelle plage va s'appliquer cette fonction ? Il y a tout un travail en amont, ce n'est pas juste un code à placer, il faut en voir la nécessité, voir analyse son impact bénéfices (harmoniser les données) / risques (ralentir le fichier au point de le rendre inutilisable). Mais là seul vous allez pouvoir faire ce travail.
Pour ce qui est du reste, toujours se dire est ce qu'il existe une alternative native sous EXCEL avant de rentrer dans du VBA qui nécessite régulièrement des maintenances, potentiellement des bugs, etc ...
En dernier lieu, mettez vous à la place de l'utilisateur. Par exemple, je ne renseigne que quelques cellules mais j’exécute la macro > Je vais me retrouver avec un pavé dans mon message box, va-t-il tenir ? Y a-t-il moyen de raccourcir en disant à l'utilisateur de renseigner les cellules via leur adresse uniquement, et pour la validation numérique, etc ... Laisser la liste de validation prendre le relais ? Ne vaudrait-il pas juste insérer une MEFC en cas de cellules vides et juste dire dans le MsgBox qu'il est nécessaire de renseigner les cellules surlignées en rouge. Dans ce cas là le message est beaucoup plus concis, clair et "acceptable" par l'utilisateur. Si vous surchargez trop, il va se décourager et passer à autre chose/une autre solution.
Du moins c'est la philosophie que j'adopte lorsque je travaille avec cette application : le rapport B/R et l'expérience utilisateur, tout en étant à minima "cost efficient".
Je vous laisse le soin d'adapter nos échanges à votre fichier, et le cas échéant, revenir vers nous avec un fichier représentatif.
Cdlt,
Avant tout, comme je l'ai expliqué, quel est le but d'harmoniser ces données sans accents ? Quelle est l'analyse à réaliser derrière ? Sur quelle plage va s'appliquer cette fonction ? Il y a tout un travail en amont, ce n'est pas juste un code à placer, il faut en voir la nécessité, voir analyse son impact bénéfices (harmoniser les données) / risques (ralentir le fichier au point de le rendre inutilisable). Mais là seul vous allez pouvoir faire ce travail.
La réponse est qu'en fait je vérifie que mon fournisseur n'a pas mit la même valeur entre ma matière et mon modèle (si je le fais c'est parce que j'ai reçu un fichier dans ce sens malgré l'explication en amont (guide utilisateur et présentation)).
Pour les alternatives, je dois avouer qu'Excel je ne suis pas toujours dessus, je cherche donc très vite la solution sur internet, et la plupart du temps on propose VBA en 1er, du coup je ne connaissais juste pas cette solution
La MEFC est peut être une solution effectivement pour permettre de ne pas avoir 40 lignes dans la MsgBox maintenant en soit il faudrait quand même faire pas mal d'erreur pour avoir beaucoup de lignes, dans une volonté de dire où se trouve clairement l'erreur (la volonté de prendre par la main le four) j'ai peut être plus complexifié qu'autre chose ... Je retiens l'idée de la MEFC il faudrait que je vois du coup comment l'appliquer, car il ne faut pas que ça apparaisse en rouge ou autre tout de suite alors qu'il est seulement en train de remplir le fichier, ça fera pas propre visuellement ou alors je l'intègre dans le code mais je ne sais pas comment on fait ça ..
Je vais relire votre code et essayer de l'appliquer, j'ai tout de même déposer en amont mon fichier, si vous avez le temps d'y regarder je ne suis pas contre
Merci encore à vous et bonne fin de journée/week-end,
Cordialement,
Bonjour,
Sur la base de vos commentaires la macro V2 applique une MEFC sur les cellules non conformes, la V1 est la même que celle vue précédemment mais avec le messagebox en corrigé et fonctionnel :
Sub verifier_finitions_V1()
Dim ERREUR$, L%, I%
Dim C() As Variant
C = Array(2, 3, 4, 5, 6, 7, 9)
With Sheets("Modèle")
For L = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
For I = 0 To UBound(C)
If .Cells(L, C(I)).Value = "" Then
ERREUR = ERREUR & ", " & .Cells(L, C(I)).Address
End If
Next I
Next L
End With
If ERREUR <> "" Then
MsgBox Right(ERREUR, Len(ERREUR) - 2), vbCritical, "CELLULES ATTENDANT DES VALEURS"
Else
Worksheets("Dimensions").Visible = xlSheetVisible
End If
End Sub
Sub verifier_finitions_V2()
Dim ERREUR As Boolean, L%, I%, LR%
Dim C() As Variant
C = Array(2, 3, 4, 5, 6, 7, 9)
With Sheets("Modèle")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
For L = 2 To LR
For I = 0 To UBound(C)
If .Cells(L, C(I)).Value = "" Then
ERREUR = True
Exit For
End If
Next I
Next L
If ERREUR = True Then
With Application.Union(.Range(.Cells(2, 2), .Cells(LR, 7)), .Range(.Cells(2, 9), .Cells(LR, 9)))
.FormatConditions.Add xlExpression, , "=B2="""""
.FormatConditions(1).Interior.COLOR = 7697919
End With
MsgBox "LES CELLULES SURLIGNEES DOIVENT ETRE REMPLIE", vbCritical, "CELLULES ATTENDANT DES VALEURS"
Else
Worksheets("Dimensions").Visible = xlSheetVisible
End If
End With
End Sub
Dans l'attente de votre retour.
Cdlt,
Bonjour Ergotamine,
Tout d'abord désolé du temps de réponse
Je vais regarder ton fichier et voir si je sais le décrypter je ne suis que débutant sur VBA donc beaucoup de choses sont encore assez obscures pour moi
J'ai fait un ou deux tests que je trouve très bien mais il faut que je sois sûr de le comprendre et de savoir le reproduire sinon ça n'aurait pas d'intérêt, je ne ferais que me servir de ton aide sans rien comprendre et si je dois le retravailler ou le partager ensuite, je devrais automatiquement revenir ce qui n'est pas le but
Merci encore à toi !
Cordialement,
Après analyse je comprends la partie V1 mais je suis totalement perdu sur la partie de la V2 ...
Je ne comprends pas la formule de la MEFC
=B2="" / =$B$2:$G$3;$I$2:$I$3
Surtout que je vois qu'elle est présente 4 fois dans les règles mais sans voir la différence entre chacune d'elle
Du coup ce que je comprends aussi c'est que la MEFC est faite automatiquement c'est à dire que même sans avoir donner le temps à la personne les cases sont déjà rouges ? N'est-il pas possible de passer plutôt les cases en rouges si les données rentrées (et après vérification donc click du bouton) sont fausses ?
Merci à toi et bonne journée,
Cordialement,
EDIT : D'ailleurs je vois que pour le moment ça ne s'applique que sur la ligne 2 cette MEFC mais je vois que dans la formule tu as pourtant sélectionner la ligne 2 et 3 , j'avoue être perdu
Bonjour,
Je me serais douté de votre seconde remarque mais ne souhaitais pas remodifier le code avant votre retour.
En fait la MEFC s'applique une seule fois. Si vous regardez le fichier à son ouverture, il n'y a pas de MEFC. Cependant, si on active le bouton X fois, alors elle s'incrémente X fois car je ne la nettoie pas auparavant. Dans ce cas ce code serait plus adapté où l'on vérifie d'abord qu'il existe une MEFC, puis on la nettoie avant de rechecker :Sub verifier_finitions_V2()
Dim ERREUR As Boolean, L%, I%, LR%
Dim C() As Variant
C = Array(2, 3, 4, 5, 6, 7, 9)
If ActiveSheet.Cells.FormatConditions.Count > 0 Then
ActiveSheet.Cells.FormatConditions.Delete
End If
With Sheets("Modèle")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
For L = 2 To LR
For I = 0 To UBound(C)
If .Cells(L, C(I)).Value = "" Then
ERREUR = True
Exit For
End If
Next I
Next L
If ERREUR = True Then
With Application.Union(.Range(.Cells(2, 2), .Cells(LR, 7)), .Range(.Cells(2, 9), .Cells(LR, 9)))
.FormatConditions.Add xlExpression, , "=B2="""""
.FormatConditions(1).Interior.COLOR = 7697919
End With
MsgBox "LES CELLULES SURLIGNEES DOIVENT ETRE REMPLIE", vbCritical, "CELLULES ATTENDANT DES VALEURS"
Else
MsgBox "LA VALIDATION EST CONFORME", vbInformation
Worksheets("Dimensions").Visible = xlSheetVisible
End If
End With
End Sub
Pour la formule de la MEFC je regarde si B2 est vide. En l'appliquant sur la plage B2:G3 et I2:I3 alors je regarde si chacun de ces cellules sont vides. Si c'est le cas elle est coloriée. Par exemple, en B3 la MEFC regardera B3, etc etc .... Si j'avais mis B2 en référence absolue de type $B$2 alors toutes mes cellules de la plage d'application auraient été MEFC en fonction de la valeur de B2 et non de leur propre valeur.
Pour la plage d'application elle s’étend automatiquement de la ligne 2 jusqu'à la dernière ligne remplie de la colonne A via ce passage du code :
With Application.Union(.Range(.Cells(2, 2), .Cells(LR, 7)), .Range(.Cells(2, 9), .Cells(LR, 9)))
Cdlt,
Ok je commence à comprendre (enfin je crois) ce n'est pas une règle directement faite sur la MEFC mais via le VBA
Je viens de comprendre aussi comment ça ce faisait que H2 n'était pas prit en compte avec le :
With Application.Union(.Range(.Cells(2, 2), .Cells(LR, 7)), .Range(.Cells(2, 9), .Cells(LR, 9)))
D'ailleurs pour rajouter H2 il faut aussi que je l'ajoute dans cette partie non ? (code du dessous)
C = Array(2, 3, 4, 5, 6, 7, 9)
Du coup arrive ma troisième question, comment je pourrais associer le fait de prévenir que la colonne J doit être supérieur à la colonne G (si colonne J <> "")
Pour la solution de la valeur numérique il faut que je passe par ce que vous m'avez renseigné précédemment et pour la suppression d'accent du coup il faudrait que je le fasse en mode sub workchange ?
Merci encore à vous !
Bonjour,
En effet vous avez deux alternatives :
- Soit vous l'ajouter dans le tableau :
Sub verifier_finitions_V2()
Dim ERREUR As Boolean, L%, I%, LR%
Dim C() As Variant
C = Array(2, 3, 4, 5, 6, 7, 8, 9) 'Colonne à vérifier
If ActiveSheet.Cells.FormatConditions.Count > 0 Then 'Si MEFC existe alors
ActiveSheet.Cells.FormatConditions.Delete 'La supprime
End If
With Sheets("Modèle") 'Avec feuille modèle
LR = .Cells(.Rows.Count, 1).End(xlUp).Row 'Defini la dernière ligne de la table sur la base de la colonne A
For L = 2 To LR 'Pour chaque ligne de la table de 2 à dernière ligne
For I = 0 To UBound(C) 'Pour chaque colonne définie dans C
If .Cells(L, C(I)).Value = "" Then 'Si cellule intersection de colonne et ligne est vide alors
ERREUR = True 'Passe ERREUR en vrai
Exit For 'Sort de la boucle
End If
Next I 'Passe à la colonne suivante
Next L 'Passe à la ligne suivante
If ERREUR = True Then 'Si erreur est vraie alors
With Range(.Cells(2, 2), .Cells(LR, 9)) 'Avec la plage B2:I&dernière ligne
.FormatConditions.Add xlExpression, , "=B2=""""" 'Si B2=""
.FormatConditions(1).Interior.COLOR = 7697919 'Colorie les cellules avec la couleur 7697919
End With
MsgBox "LES CELLULES SURLIGNEES DOIVENT ETRE REMPLIE", vbCritical, "CELLULES ATTENDANT DES VALEURS" 'Affiche le message box d'erreur
Else 'Sinon
MsgBox "LA VALIDATION EST CONFORME", vbInformation 'Affiche message box de validation conforme
Worksheets("Dimensions").Visible = xlSheetVisible 'Affiche feuille dimension
End If
End With
End Sub
- Soit vous supprimer le tableau car vous avez une plage continue de colonne que vous pouvez directement inclure dans la boucle ce qui donne :
Sub verifier_finitions_V2()
Dim ERREUR As Boolean, L%, I%, LR%
If ActiveSheet.Cells.FormatConditions.Count > 0 Then 'Si MEFC existe alors
ActiveSheet.Cells.FormatConditions.Delete 'La supprime
End If
With Sheets("Modèle") 'Avec feuille modèle
LR = .Cells(.Rows.Count, 1).End(xlUp).Row 'Defini la dernière ligne de la table sur la base de la colonne A
For L = 2 To LR 'Pour chaque ligne de la table de 2 à dernière ligne
For I = 2 To 9 'Pour indice de colonne entre 2 et 9 (donc B à I)
If .Cells(L, I).Value = "" Then 'Si cellule intersection de colonne et ligne est vide alors
ERREUR = True 'Passe ERREUR en vrai
Exit For 'Sort de la boucle
End If
Next I 'Passe à la colonne suivante
Next L 'Passe à la ligne suivante
If ERREUR = True Then 'Si erreur est vraie alors
With Range(.Cells(2, 2), .Cells(LR, 9)) 'Avec la plage B2:I&dernière ligne
.FormatConditions.Add xlExpression, , "=B2=""""" 'Si B2=""
.FormatConditions(1).Interior.COLOR = 7697919 'Colorie les cellules avec la couleur 7697919
End With
MsgBox "LES CELLULES SURLIGNEES DOIVENT ETRE REMPLIE", vbCritical, "CELLULES ATTENDANT DES VALEURS" 'Affiche le message box d'erreur
Else 'Sinon
MsgBox "LA VALIDATION EST CONFORME", vbInformation 'Affiche message box de validation conforme
Worksheets("Dimensions").Visible = xlSheetVisible 'Affiche feuille dimension
End If
End With
End Sub
Pour votre troisième question tout se joue au niveau de la validation de données, ça évite de passer par du VBA :
Renseignez 0 en J2 vous verrez par vous même apparaître un message d'erreur. Après peut être vaut-il mieux le mettre dans la MEFC, libre à vous en fonction de vos besoins.
Pour la suppression des accents je pense en effet que c'est plus simple de passer par un Worksheet_Change au lieu de le répéter à chaque vérification, ce qui peut ralentir la vitesse d’exécution.
Il faut que vous testiez.
Cdlt,
Pour votre troisième question tout se joue au niveau de la validation de données, ça évite de passer par du VBA :
Pour cette partie j'avais essayé avec une formule (qui à l'air ok) :
(Il faut que je vois comment je peux étendre la formule aussi je maitrise pas trop cette partie de validation de données, je suis plus sur les listes déroulantes d'habitudes haha)
Après peut être vaut-il mieux le mettre dans la MEFC, libre à vous en fonction de vos besoins.
En vrai, j'aimerais bien l'intégrer directement dans le MEFC, je réfléchis seulement à comment, il devrait y avoir :
If .Cells(L, 10).Value <> "" Then
If .Cells(L, 10) < .Cells(L, 8) Then
Enfin j'imagine un début comme ça non ? Le problème c'est comme réussir à l'intégrer dans l'erreur et la MEFC ? Il ne faudrait pas en faire une à part du coup car c'est assez spécifique ? Je sais pas trop ..