Excel VBA comparer

Version imprimable

Excel VBA comparer

Bonjour, j'aurais besoin d'aide pour une fonction que je ne maitrise pas.

Voici se que j'aimerais faire:

Colonne A
(nombre de camions qui quittent le bureau) colonne B
(nombre d'items que le camion avait en quittant) Colonne C
(nombre de camions qui reviennent au bureau) Colonne D
(nombre d'items que le camion nous retourne)

750 13 751 14

751 14 753 12

752 6 750 13

753 12 752 5

Alors j'aimerais une VBA avec un bouton qui comparerai la sortie (colonne a & B) avec les entrée (colonne C & D) et affiche en msgbox la route & l'item manquant, qui ne correspond pas. Comme dans mon exemple ci-haut, le camion #752 a quitté avec 6 items et au retour il nous en apporte uniquement 5. Alors j'aimerais msgbox: Attention, la route 752 ne balance pas !

23/12/2020, 11h11
Pierre Fauconnier

2 pièce(s) jointe(s)

Salut.

A priori, sauf besoin particulier, il n'est pas nécessaire d'utiliser VBA pour cela. Une simple formule pour comparer les items par camion suffit, avec éventuellement une mise en forme conditionnelle pour mettre les écarts en évidence.

Pièce jointe 587298

Cela dit, la conception des colonnes et des tableaux est à revoir, à mon avis, et perso, je passerais par des tableaux structurés pour réaliser la saisie et l'agencement des données.

Bien agencées, les données permettraient, selon ta version d'Excel, d'utiliser Power Query pour réaliser le tableau comparatif. Si ton tableau grandit, il te suffit d'actualiser le tableau de résultat pour voir apparaître les nouveaux écarts.

Pièce jointe 587300

J'ai un doute sur le fait que ton vrai modèle de données soit si simple, voire si simpliste, car je suppose que tu vas avoir une notion de dates ou d'ordres de trajets. Si un camion rentre et sort plusieurs fois, comment déterminer les paires d'aller-retour, par exemple?

Attention à ne pas trop simplifier ce que tu nous demandes, car c'est souvent plus une perte de temps qu'un gain ;)

Ici, le problème est bien moins un problème de formule ou de vba qu'un problème de conception.
23/12/2020, 12h17
sylvaindem

Bonjour pierre,

Effectivement, j'ai extrêmement simplifier ma demande afin de ne pas mélanger pour rien les gens. La raison pourquoi je demande un vba c'est que la sortie des camions et l'entré des données se fait avec des userform différent. et j'aimerais avoir un bouton dans mon userform des camions qui retourne, qui me permet de suivre au fur et a mesure en cliquant dessus si mes donnée concorde ou non et ainsi avoir un msgbox m'indiquant quel camion est en erreur afin de corriger la situation. Les données out et ceux in ne se retrouvent pas dans le même tableur ni meme sur la meme feuille de calculs. C'est ainsi pourquoi j'ai demander simple pour adapter après :P

Colonne A (nombre de camions qui quittent le bureau)	colonne B (nombre d'items que le camion avait en quittant)	Colonne C (nombre de camions qui reviennent au bureau)	Colonne D (nombre d'items que le camion nous retourne)
750	13	751	14
751	14	753	12
752	6	750	13
753	12	752	5

1 pièce(s) jointe(s)

bonjour
proposition d'un débutant à tester avec prudence

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub testtt()
Set f1 = Sheets("Feuil1")
  Set dS = CreateObject("scripting.dictionary")
  dS.CompareMode = vbTextCompare
   TblBD = f1.Range("A2:D" & f1.Range("A" & Rows.Count).End(xlUp).Row)
  For i = 1 To UBound(TblBD)
    clé = TblBD(i, 1)
    dS(clé) = dS(clé) + TblBD(i, 2)
  Next i  
  Set dR = CreateObject("scripting.dictionary") 
   dR.CompareMode = vbTextCompare 
   For i = 1 To UBound(TblBD)
    clé = TblBD(i, 3)
    dR(clé) = dR(clé) + TblBD(i, 4)
  Next i
 
  cam = Application.InputBox("saisir numéro du camion ?", Type:=1, Title:="Saisir 3 chiffres")
 
   For Each c In dS
   If c = cam Then
   X = dS.Item(c) - dR.Item(c)
   MsgBox ("Ce camion à quitté avec :  " & dS.Item(c) & "  Et a retourné :  " & dR.Item(c) & " le solde est de: " & X)
   End If
   Next c
 End Sub

1 pièce(s) jointe(s)

Voilà comment je procèderais, bien entendu, sur base de tableaux structurés, t_Allers pour les départs et t_Retours pour les retours. En procédant avec des tableaux structurés, tu te détaches ainsi de tes classeurs et de tes feuilles, et tu détermines en amont les tableaux qui vont servir à la comparaison.

Pièce jointe 587321

je crée une fonction qui reçoit le numéro du camion, le tableau des départs et celui des arrivées, et qui renvoie soit Empty (le camion n'a pas été trouvé pour au moins un des trajets), soit l'écart. Après, tu traites le résultat de la fonction et tu envoies éventuellement un message à l'utilisateur selon le résultat de la fonction.

En découplant le calcul de l'écart de l'avertissement envoyé à l'utilisateur et en renvoyant l'écart plutôt que True ou False, tu as plus de souplesse pour déterminer si l'écart est important ou pas et tu peux gérer cet écart pour l'afficher, l'additionner à d'autres valeurs, etc...

La fonction se place bien entendu dans un module standard.
Code:

1 2 3 4 5 6 7 8 9 10 11 Function getGap(TruckNummer As Long, PathTo As Range, PathFrom As Range) Dim Pos Dim CountOf As Long Pos = Application.Match(TruckNummer, PathTo.ListObject.ListColumns("Camion").DataBodyRange, 0) If Not IsError(Pos) Then CountOf = PathTo.ListObject.ListColumns("Items").DataBodyRange(Pos).Value Pos = Application.Match(TruckNummer, PathFrom.ListObject.ListColumns("Camion").DataBodyRange, 0) If Not IsError(Pos) Then getGap = CountOf - PathFrom.ListObject.ListColumns("Items").DataBodyRange(Pos) End If End Function
Elle peut être appelée par une procédure standard, par un évènement de contrôle de userform, ... Ici, elle est appelée par un module standard.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub Test() Dim TruckNummer As Long Dim Gap TruckNummer = 752 Gap = getGap(TruckNummer, Range("t_Allers"), Range("t_Retours")) If Not IsEmpty(Gap) Then MsgBox "Ecart = " & Gap Else MsgBox "Le numéro du camion est incorrect" End If End Sub

24/12/2020, 07h35
sylvaindem

Pierre Fauconnier, ton code fonctionne à merveille, merci !

Crois-tu que dans le même principe, c'est possible qu'il indique:

- si tout est ok, indique "aucune erreur"

- si un camion ne concorde pas, qu'il m'affiche dans le msgbox lequel (ou lesquels) ?

exemple: Le camion "750" de balance pas.

Ou

Les camion "750" et "751" ne balance pas.

J'en demande beaucoup, je m'excuse d'avance !
24/12/2020, 08h06
BENNASR

il y a une réponse Hier à 13h16...ne nécessite pas une réponse ??
24/12/2020, 08h22
sylvaindem

BENNASR,

Désolé j'avais pas eu le temps de la tester.

Malheureusement ça ne fait pas tout a faite se que j'ai besoin. Je ne veux pas vérifier camion par camion. Il ma faut un seul clique = résultat de ceux qui ne balance pas. Est-ce que ton script serais ajustable pour y arriver ?

Merci :-)

@ Sylvain

Dans la mesure où tu parlais de userform dans ton message, j'ai compris que tu ne gérais qu'un camion à la fois dans ton userform. La découpe du code en une fonction qui renvoie l'écart des items permet d'adapter à chaque situation, et on pourrait donc boucler sur les camions du tableau des départs et créer un msgbox ou remplir une listbox avec ceux qui sont en erreur, ou tous... C'est l'avantage de découper le process en plusieurs morceaux qui ont une seule responsabilité.

Sans connaître la conception de ton système, il est malaisé de t'aider. La solution que je te proposais au début créait un tableau avec les écarts, et ça me semblerait correspondre à ton besoin.

Voici une fonction qui boucle sur les camions de l'aller et qui, pour chaque camion, utilise la fonction donnée dans mon précédent post. Elle renvoie un tableau des "réponses" que tu peux utiliser à ta guise, par exemple dans un msgbox, dans un listbox, dans un tableau structuré... Tu as le choix ;)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 Function getAllTrucksGaps() Dim TruckNummer As Long Dim Gap Dim i As Long ReDim t(0 To Range("t_Allers").Rows.Count - 1) Dim Message As String For i = 1 To Range("t_Allers").Rows.Count Gap = getGap(Range("t_Allers[camion]")(i), Range("t_Allers"), Range("t_Retours")) If Not IsEmpty(Gap) Then If Gap = 0 Then Message = "Pas d'erreurs" Else Message = "Ecart de " & Gap End If Else Message = "Camion non trouvé" End If t(i - 1) = "Camion " & Range("t_Allers[camion]")(i) & ": " & Message Next i getAllTrucksGaps = t Erase t End Function Sub Test() Dim t Dim Message As String t = getAllTrucksGaps Message = Join(t, Chr(13)) MsgBox Message End Sub

bonjour
si vous envoyez les camions non régularisés vers une feuille "feuil2"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
 Sub testtt()
 Dim f1 As Worksheet
 Dim f2 As Worksheet
 
Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
  Set dS = CreateObject("scripting.dictionary")
  dS.CompareMode = vbTextCompare
 
  derlig1 = f1.Range("A" & Rows.Count).End(xlUp).Row
  derlig2 = f1.Range("C" & Rows.Count).End(xlUp).Row
  If derlig1 > derlig2 Then
  derlig = derlig1
  Else
   derlig = derlig2
  End If
 
   TblBD = f1.Range("A2:D" & derlig)
  For i = 1 To UBound(TblBD)
    clé = TblBD(i, 1)
    dS(clé) = dS(clé) + TblBD(i, 2)
  Next i
 
  Set dR = CreateObject("scripting.dictionary")
 
   dR.CompareMode = vbTextCompare
   For i = 1 To UBound(TblBD)
 
    clé = TblBD(i, 3)
    dR(clé) = dR(clé) + TblBD(i, 4)
  Next i
 
  lig = 2
  f2.Cells.ClearContents
  f2.Cells(1, 1) = "Code Camion"
  f2.Cells(1, 2) = "Quantité sortie"
  f2.Cells(1, 3) = "Quantité retournée"
  f2.Cells(1, 4) = "Ecart"
 
   For Each c In dS
   X = dS.Item(c) - dR.Item(c)
   If X <> 0 Then
    f2.Cells(lig, 1) = c
   f2.Cells(lig, 2) = dS.Item(c)
    f2.Cells(lig, 3) = dR.Item(c)
     f2.Cells(lig, 4) = X
   If f2.Cells(lig, 1) <> "" Then lig = lig + 1
   End If
 
   Next c
 
 End Sub

24/12/2020, 08h36
Pierre Fauconnier

2 pièce(s) jointe(s)

Citation:

Envoyé par sylvaindem

[...]Il ma faut un seul clique = résultat de ceux qui ne balance pas.[...]

Je me tournerais alors vers ma solution de départ, adaptée pour fusionner les deux tableaux et renvoyer par Power Query le tableau de résultat que tu pourrais traiter comme tu l'entends... Il suffit d'un clic droit pour rafraichir le tableau des écarts, que tu peux réaliser par VBA pour inclure ce process dans ton userform.

Pièce jointe 587365
24/12/2020, 08h52
sylvaindem

BENNASR,

On progresse !!! yes !

Dernière étape souhaité, pouvoir faire apparaitre le résultat dans un msgbox au lieux daller voir dans le feuille2 les résultats. C'est possible ?
24/12/2020, 08h53
BENNASR

je crois pas...mais tu peux afficher un userform avec un listbox alimenté depuis cette nouvelle page
24/12/2020, 08h55
Pierre Fauconnier

1 pièce(s) jointe(s)

Citation:

Envoyé par sylvaindem

[...]pouvoir faire apparaitre le résultat dans un msgbox au lieux daller voir dans le feuille2 les résultats. C'est possible ?

C'est exactement ce que je te propose dans mon message de 8h27 ;)

Pièce jointe 587367

2 pièce(s) jointe(s)

Salut BENNASR

Citation:

Envoyé par BENNASR

je crois pas...mais tu peux afficher un userform avec un listbox alimenté depuis cette nouvelle page

On peut itérer sur les cellules pour créer le msgbox. Sur base de mon tableau de résultat

Pièce jointe 587368
Code:

1 2 3 4 5 6 7 8 9 10 Sub CreateMsgbox() Dim Message Dim r As Range For Each r In Range("Ecarts[Personnalisé]") Message = Message & r.Value & vbCr Next Message = Left(Message, Len(Message) - 1) MsgBox Message End Sub
Pièce jointe 587369

A toi d'adapter le code à ton tableau, bien sûr ;)

24/12/2020, 09h07
sylvaindem

Merci à tous ! vous m'avez aidé grandement et tout fonctionne. Vous êtes des pros !:zoubi:
24/12/2020, 10h55
sylvaindem

VBA donné déja présente = erreur

Bonjour à vous tous !

Petite question. Quelqu'un peux m'aider à faire le code pour ceci ?

J'ai un userform avec un textebox nommé "rteid" (pour route identification)

J'aimerais qu'en cliquant enregistrer, qu'il vérifie si l'entré de "rteid" n'est pas déjà présent dans mon tableau et me renvoie une erreur uniquement si elle y est déjà pour faire un exit sub. Sinon que le vba continue normalement.

Ma feuille de donnée ou s'enregistre actuellement mes entrées se nomme "Database". Dans la colonne "B".

Merci :-)

1 pièce(s) jointe(s)

Rebonjour Sylvain ;)

Sur base du clic sur un bouton, on pourrait exécuter la procédure ci-dessous s'appuyant sur un tableau structuré nommé Tableau1:

Pièce jointe 587380
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub btnRun_Click() ExecuteProcess End Sub Sub ExecuteProcess() If Application.CountIfs(Range("tableau1[Route]"), rteid.Value) = 0 Then '... '... Else MsgBox "Cette route existe déjà" End If End Sub
NB: Pas de Exit Sub dans ton code svp, ce n'est pas très propre car cela crée plusieurs sorties de fonction qu'il va falloir contrôler...

24/12/2020, 11h38
sylvaindem

encore une fois, MERCI !!! Ca fonctionne a merveille !
26/12/2020, 16h46
sylvaindem

vba comparer 2 listes et donner erreur si difference

Bonjour,

cette semaine jai demandé la question et j'ai eu plusieurs réponses, mais malheureusement pas tout a fait se que j'ai besoin. Je me réésaye aujourd'hui :-)

J'ai deux feuilles, "feuil1" et "feuil2". J'aimerais ajouter un bouton de commande dans un de mes formulaire actuel qui pourrais comparer les résultats de la feuil1 et de la feuil 2 et m'afficher dans une msgbox les erreurs (si erreur il y a).

Exemple:

Feuil1:

coll B: coll C:

700 3

701 5

702 2

703 6

704 1

705 9

feuil 2

coll B: coll C:

700 4

704 1

705 9

703 6

701 5

702 4

En cliquant sur le bouton, j'aimerais avoir le résultat suivant: "700 & 702 sont en erreur".

Si tout concorde, message: "aucune erreur"

P.S. j'aimerais que le code soit en référence au nom de page et au numéro de colonne et non pas a des nom de tableau. Mon projet est déjà presque fini de cette facon :-)

Merci d'avance pour votre aide si précieuse !
26/12/2020, 22h34
mfoxy

Hello,

"j'aimerais que le code soit en référence au nom de page et au numéro de colonne et non pas a des nom de tableau. Mon projet est déjà presque fini de cette facon :-)"

Pour ce faire, il vous suffit de passer votre range dans les fonctions proposées (légèrement modifiées) notamment par Pierre F. dans votre autre Post (du même sujet).

Pour ma part, je ne peux que vous poussez à bien réfléchir, et à vous documenter au sujet des tableaux structurés, ceux-ci n'offrent que des avantages et ,selon moi, dans un avenir proche seront incontournable pour une bonne utilisation d'excel et des nouveaux outils. Il voudrait peut-être mieux "perdre" qq heures à chaud, maintenant, dans votre projet que de nombreuses à l'avenir.

Bav,
27/12/2020, 01h18
Alex020181

1 pièce(s) jointe(s)

Bonjour,

Voici une façon de faire qui peut être améliorée mais qui fait déjà votre demande.

A vous de finaliser (nombre de lignes maximum à prendre en compte, non prise en compte pour les cas où pas de données en colonne "B", ...).

Testez et dites-nous.
27/12/2020, 13h59
Pierre Fauconnier

Salut.

Je ne peux que plussoier Michaël. L'utilisation des tableaux struturés, déjà renseignés, permet un allègement du code, une maintenance facilitée et une évolutivité accrue. L'utilisation de feuilles et tableaux temporaires permettraient également de se passer du dictionnaire, outil externe à VBA qui demande des notions de programmation alors que le couple Excel/VBA a tout en magasin pour fournir des solutions contrôlables et compréhensibles par le "non programmeur" => VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA... ;)
27/12/2020, 16h37
sylvaindem

Merci INFINIMENT !!!!
29/12/2020, 14h20
sylvaindem

Citation:

Envoyé par Alex020181

Bonjour,

Voici une façon de faire qui peut être améliorée mais qui fait déjà votre demande.

A vous de finaliser (nombre de lignes maximum à prendre en compte, non prise en compte pour les cas où pas de données en colonne "B", ...).

Testez et dites-nous.

C'est tellement formidable ton fichier ! Je t'en remercie beaucoup. La seul "probleme" c'est qu'il vérifie uniquement si la donnée de la feuil2 se trouve dans la feuil1. Si par mégarde une donnée se retrouve dans la feuille1 mais pas encore dans la feuil2, il indique aucune erreur...

Crois tu qu'on pourrais garder la logique actuel de ton test, mais aussi ajouter qu'il indique erreur si une donnée se retrouve seul dans la feuil1 ? :roll:
08/01/2021, 09h57
sylvaindem

Quelqu'un a une solution de modification de l'idée de Alex 020181 ?

coll B:	coll C:
700	3
701	5
702	2
703	6
704	1
705	9

coll B:	coll C:
700	4
704	1
705	9
703	6
701	5
702	4