XL 2016 Comparer plusieurs valeurs dans 2 colonnes

julien741 · 6 Janvier 2022

Bonjour,
Je sollicite votre aide car je n'arrive pas a faire le code pour comparer les valeurs entre 2 colonnes.
Vous trouverez ci-joint le fichier pour mieux comprendre.
Dans l'onglet FPE1 je souhaiterais comparer les valeurs de G11:G70 avec ceux de H11:H70 (ligne par ligne entre ces 2 colonnes)
Dans la colonne G on a des valeurs (compteur de début de prod) et dans la colonne H on a des valeurs (compteur de fin de prod), donc on doit avoir toujours une valeur supérieur dans la colonne H que celle de G.
J'ai donc mit un message d'alerte, si lorsque l'on rentre les valeurs dans la colonne G ne peut pas être au dessus de la colonne H.
Pour cela j'ai fait ce code qui fonctionne mais juste pour une ligne :

'Excecute la suite si le compteur de départ est inférieur au compteur de fin

Dim compteurd As Integer, compteurf As Integer, resultat As Integer
compteurd = Range("G11")
compteurf = Range("H11")
If compteurd < compteurf Then
ElseIf compteurd >= compteurf Then
resultat = MsgBox("Valeur du compteur de départ et supérieur au compteur de fin, merci de corriger", vbOKCancel + vbCritical)
If resultat = vbOK Then
Exit Sub
End If
End If

L'idée est de comparé les autres lignes des 2 colonnes jusqu'a la ligne 70.

Merci par avance de votre aide.
Cdt.
Julien.

sylvanu · 6 Janvier 2022

Il suffit de rajouter le traitement si OK :

VB:

If R = 1 Then Exit Sub

sylvanu · 6 Janvier 2022

Bonjour Julien,
En PJ un essai avec une macro événementielle dans FPE1.
Lorsque la valeur saisie en H est < à G alors on émet une alerte. C'est automatique à la saisie de la valeur, avec :

VB:

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [H11:H1000]) Is Nothing Then
        If Target < Cells(Target.Row, "G") Then
            resultat = MsgBox("Valeur du compteur de départ et supérieur au compteur de fin, merci de corriger", vbOKCancel + vbCritical)
            Application.EnableEvents = False
            Target = ""
            Application.EnableEvents = True
        End If
    End If
End Sub

NB: j'ai mis le fichier en format xlsb, c'est beaucoup plus léger, et ne porte pas à conséquence si le fichier est utilisé sur PC. Vous pouvez le ré enregistrer en xlsm.

julien741 · 6 Janvier 2022

Bonjour Sylvanu,

Merci de coups de main cela m'aide et merci pour ta rapidité, moi j'ai cherché pendant 2 jours avant de demander de l'aide. la macro fonctionne bien, je n'y avait pas pensé à mettre directement la macro dans l'onglet pour que lors de la saisie le message s'affiche aussitôt.

Je ne savais pas non plus qu'en enregistrant dans ce format cela fonctionne aussi, c'est vrai que le fichier est beaucoup moins lourd.

Par contre je souhaiterais quand même continuer avec le bouton, la formule est-elle la même? et sur le bouton je souhaiterais laisser le choix OK et annuler.
Merci à toi.
Cdt.
Julien.

sylvanu · 6 Janvier 2022

Voir PJ, j'ai inhibé la fonction automatique.
Dans votre prog j'ai mis :

VB:

'Excecute la suite si le compteur de départ est inférieur au compteur de fin
Dim Ligne%, R, DL%, L%
For Ligne = 11 To Range("H65500").End(xlUp).Row
    If Cells(Ligne, "H") < Cells(Ligne, "G") Then
        R = MsgBox("La valeur du compteur de départ et supérieur" & Chr(10) & "au compteur de fin en ligne " & Ligne & Chr(10) & "Merci de corriger", vbOKCancel + vbCritical)
    End If
Next Ligne

A mon avis il vaut mieux faire la vérif en temps réel plutôt que de la faire au transfert. Mais ça dépend de l'utilisation.

julien741 · 6 Janvier 2022

Je viens d'essayer le fichier, le problème c'est que lorsque l'on mets ok, la macro ne s'arrête pas.
Il faut que si une erreur apparait, on appuie sur ok la macro s'arrête et si on met annuler pour X ou Y raison la macro continue.

sylvanu · 6 Janvier 2022

Il suffit de rajouter le traitement si OK :

VB:

If R = 1 Then Exit Sub

julien741 · 6 Janvier 2022

C'est vrai, j'aurais pu le faire, je viens de voir aussi un soucis, je viens de lancer la macro, et la BDD ne se rempli plus, pour toi ca fonctionne?

sylvanu · 6 Janvier 2022

Oui, ça marche.
Mais vous avez remarqué qu'après "'Transfert des données dans la BDD" absolument rien n'avait changé, donc c'est le même comportement qu'avant.
Par contre une question :
Quand on clique sur OK, on sort bien de la macro ?
Ou alors ne faut il sortir que de la vérification de la colonne H.
Dans ce cas il faudrait modifier :

VB:

'Excecute la suite si le compteur de départ est inférieur au compteur de fin
Dim Ligne%, R, DL%, L%
For Ligne = 11 To Range("H65500").End(xlUp).Row
    If Cells(Ligne, "H") < Cells(Ligne, "G") Then
        R = MsgBox("La valeur du compteur de départ et supérieur" & Chr(10) & "au compteur de fin en ligne " & Ligne & Chr(10) & "Merci de corriger", vbOKCancel + vbCritical)
        If R = 1 Then Exit Sub
    End If
Next Ligne
'Transfert des données dans la BDD

par :

Code:

'Excecute la suite si le compteur de départ est inférieur au compteur de fin
Dim Ligne%, R, DL%, L%
For Ligne = 11 To Range("H65500").End(xlUp).Row
    If Cells(Ligne, "H") < Cells(Ligne, "G") Then
        R = MsgBox("La valeur du compteur de départ et supérieur" & Chr(10) & "au compteur de fin en ligne " & Ligne & Chr(10) & "Merci de corriger", vbOKCancel + vbCritical)
        If R = 1 Then GoTo Suite
    End If
Next Ligne
Suite:
'Transfert des données dans la BDD

julien741 · 6 Janvier 2022

Il faut que la macro vérifie les colonnes G et H.
si erreur, le message apparait avec les numéros de ligne erroné et lorsque l'on met ok la macro s'arrête, si on met annuler elle continue.
Si pas d'erreur entre les 2 colonnes la macro s'exécute normalement.

sylvanu · 6 Janvier 2022

Alors c'est ce qui se passe avec la macro actuelle.
Votre problème vient d'ailleurs.

julien741 · 6 Janvier 2022

Merci pour ton aide, c'est tout bon, je viens de refaire des tests et cela fonctionne, je ne sais pas pourquoi cela n'avait pas fonctionné tout a l'heure.

XL 2016 Comparer plusieurs valeurs dans 2 colonnes

julien741

XLDnaute Nouveau

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

julien741

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

julien741

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

julien741

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

julien741

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

julien741

XLDnaute Nouveau

Discussions similaires