Comparaison en VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

17/05/2016, 15h17
Mateos_hiss

1 pièce(s) jointe(s)

Comparaison en VBA

Bonjour

je travail sur un projet un peu compliqué ou je dois comparer 5 colonnes a d'autre 5 colonnes comme dans cette photo exemple
Pièce jointe 209911

le principe c'est de comparer les fonctionnalitées entre les deux releases et dans le resultats on aura les nouvelles fonctionnalitées qui existent dans le release2 et qui n'existent pas dans le release 1 en affichant aussi les communautées qui utilisent ces nouvelles fonctionnalitées avec le pourcentage de leur PNR dependant de du Total PNRS , je galére a trouver une solution vu que je suis un debutant en VBA , c'est la premiere fois que je participe dans le forum j'espere que vous m'aidiez , merci d'avance
17/05/2016, 16h56
Al__22

La comme ça a chaud je vois plusieurs solution mais à mon avis le plus simple pour toi ce serait d'utiliser un dico qui enregistre les fonctionnalités de ton release 1 et qui après regarde celle de ton release 2 et qui à chaque fois qu'il découvre une nouvelle fonctionnalité tu implante ton histoire de communauté et tout :mrgreen:

Je te laisse allé voir d'abords ces liens si mon idée t'intéresse :
http://plasserre.developpez.com/cour...age-vb3#LV-I-6

http://access.developpez.com/sources...onnaireDonnees
17/05/2016, 17h06
Mateos_hiss

Rep

merci pour ta reponse mais ca c'est encore plus compliqué pour moi vu que je suis qu'un debutant lool , y a pas d'autre moyens plus facil ?
17/05/2016, 17h13
Al__22

Après tu peux comparer ligne par ligne, ce serait peut être plus simple pour toi ;)

Pour commencer tu cherches le nombres de lignes maxi dans ton premier tableau que tu enregistre dans une variable
Idem pour le deuxième tableau
Puis tu compare ligne par ligne dans une double boucle avec des if ... then ...

Tu penses y arriver ?
17/05/2016, 17h18
MacKay77

Bonjour,

une variable de test en boolean qu'on appellera "test_comparaison" et qu'on initialisera à false
Une boucle pour parcourir le tableau release 2.
Dans cette boucle une seconde boucle pour parcourir le tableau release 1
Dans cette seconde boucle, une comparaison entre la fonctionnalité de release 2 et de release 1
Si ce sont les mêmes, on passe test_comparaison à true on quitte la boucle du release 1 et on passe à l'élément suivant de la boucle du release 2.
Si ce ne sont pas les mêmes, on continue la boucle du release 1
Si à la fin de la boucle du release 1, test_comparaison est toujours à false, on stocke dans les résultats la fonctionnalité et tout ce qui s'en suit.

Bonne journée !
17/05/2016, 17h22
Mateos_hiss

Merci beaucoup a vous je vais essayer ca maintenant

Bonjour mateo,

Je sais pas si du coup tu as réussi ton histoire mais pour t'aider (je l'ai fais très rapidement ce matin donc il y a moyen de l'améliorer ou de faire beaucoup mieux, notamment en mettant un double find mais bon la flemme :mouarf:) je peux te proposer ceci (il faut bien entendu l'adapter à ton cas) :

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
Sub essai()
 
Dim verif As Range 'variable qui vérifie si ta valeur existe ou non
 
x = Sheets(1).Range("C4:C" & Sheets(1).Range("C:C").End(xlDown).Row).Count 'compte le nombre de ligne dans ton tableau 1
y = Sheets(1).Range("I4:I" & Sheets(1).Range("I:I").End(xlDown).Row).Count ''compte le nombre de ligne dans ton tableau 1
 
For j = 4 To y + 4 'pour chaque ligne de ton tableau 2
 
a = Sheets(1).Range("N1:N" & Sheets(1).Range("N:N").End(xlDown).Row).Count + 1 'dernière ligne T3
 
m = 0 'variable vérifiant si elle existe dans ton tableau 1
 
    For i = 4 To x + 4 'pour chaque ligne de ton tableau 1
 
    If Sheets(1).Cells(j, 9).Value = Sheets(1).Cells(i, 3).Value Then m = 1 'si la ligne de ton tableau 2 = ligne tableau 1
 
    Next i 'ligne suivante T1
 
If m = 0 Then 'si pas d'occurance entre T1 et T2
PNR = 1 - (Sheets(1).Range("J19").Value - Sheets(1).Cells(j, 10).Value) / Sheets(1).Range("J19").Value 'ton histoire de %
PNR = Format(PNR, "0.00%") 'le format voulu
Set verif = Sheets(1).Range("N:N").Find(Sheets(1).Cells(j, 9).Value) 'on cherche si on ne l'a pas déjà
 
    If verif Is Nothing Then 'si on l'a pas déjà
    Sheets(1).Cells(a, 14).Value = Sheets(1).Cells(j, 9).Value 'on récupère le nom
    texte = Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR 'on applique l'histoire du PNR
    Sheets(1).Cells(a, 15).Value = texte 'on met l'histoire du PNR dans la colonne suivante
 
    Else 'si on l'a déjà
    texte = Sheets(1).Cells(verif.Row, 15).Value 'on récupère ce qu'il y avait déjà
    texte = texte & "; " & Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR 'on ajoute la nouvelle ligne
    Sheets(1).Cells(verif.Row, 15).Value = texte 'on mets le tout à la place
 
    End If
 
End If
 
Next j 'ligne suivante pour T2
 
End Sub

18/05/2016, 10h27
Mateos_hiss

Bonjour AL__22,

Merci beacoup pour ton aide enfaite j'ai essayé de faire un truc mais ca marche pas je suis null lool , ton code marche parfaitement , parcontre j'ai trouvé une autre ambiguité c'est dans le calcule du total PNR vu que j'ai les valeurs qui se repetent dans la colonne J , y a t-il une maniere de calculer ce total pour chaque communauté sans repeter la valeur ??

Une solution relativement longue (Ca dépend de la taille du tableau) serait de :
créer un tableau
créer une boucle pour parcourir les PNR
tester si le PNR actuel est stocké dans le tableau (à l'aide d'une boucle sur le tableau et d'une comparaison à chaque valeur du tableau)
ajouter le PNR s'il n'y est pas déjà
faire la somme de tous les PNR du tableau

Sinon tu peux utiliser les collections :
Code:

1 2 3 4 5 6 Dim coll As New Collection dim compteur as integer On Error Resume Next For compteur = 3 to a 'le a qui stocke le nombre de lignes coll.Add range("J" & compteur), range("J" & compteur) Next
et derrière, on fait la somme des valeurs contenues dans la collection

explication :
une collection c'est à peu près comme un tableau mais avec un identifiant pour chaque valeur. L'identifiant doit être unique sinon ça cause une erreur, erreur qui est ignorée par "On Error Resume Next ".
La collection va donc se retrouver avec seulement des valeurs uniques si on prend pour identifiant la valeur.
C'est un peu tordu mais ça devrait marcher.

18/05/2016, 11h13
Al__22

Citation:

Envoyé par Mateos_hiss

Bonjour AL__22,

Merci beacoup pour ton aide enfaite j'ai essayé de faire un truc mais ca marche pas je suis null lool , ton code marche parfaitement , parcontre j'ai trouvé une autre ambiguité c'est dans le calcule du total PNR vu que j'ai les valeurs qui se repetent dans la colonne J , y a t-il une maniere de calculer ce total pour chaque communauté sans repeter la valeur ??

J'ai pas compris 8O
18/05/2016, 11h28
Mateos_hiss

enfaite pour calculer le pourcentage je dois caculer le total de tout les PNR mais vu que les valeur se repetent j'aurai pas la vrai valeur du total PNR du coup je dois calculer ce total dependant sur chaque communauté pour l exemple que j'ai fournie le total PNR dois etre 35387 et pas 103495 parceque les communauté se repetent du coup leurs PNRs se repetent je suis entrain de voir comment je peux utiliser le code que Mackay 77 a proposé avec le code que tu m a fournie

D'accord et bah du coup : vive les dico !!! :mouarf:

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
Sub essai2()
 
Dim dico As New Dictionary
x = Sheets(1).Range("C4:C" & Sheets(1).Range("C:C").End(xlDown).Row).Count
y = Sheets(1).Range("I4:I" & Sheets(1).Range("I:I").End(xlDown).Row).Count
Sheets(1).Range("J19").Value = ""
 
For i = 4 To x + 4
If Not dico.Exists(Sheets(1).Cells(i, 3).Value) Then dico.Add Sheets(1).Cells(i, 3).Value, Sheets(1).Cells(i, 4).Value
Next i
 
For i = 4 To y + 4
If Not dico.Exists(Sheets(1).Cells(i, 10).Value) Then
dico.Add Sheets(1).Cells(i, 10).Value, Sheets(1).Cells(i, 10).Value
Sheets(1).Range("J19").Value = Sheets(1).Range("J19").Value + Sheets(1).Cells(i, 10).Value
End If
If Not dico.Exists(Sheets(1).Cells(i, 9).Value) Then
 
a = Sheets(1).Range("N1:N" & Sheets(1).Range("N:N").End(xlDown).Row).Count + 1
PNR = 1 - (Sheets(1).Range("J19").Value - Sheets(1).Cells(i, 10).Value) / Sheets(1).Range("J19").Value
PNR = Format(PNR, "0.00%")
Set verif = Sheets(1).Range("N:N").Find(Sheets(1).Cells(i, 9).Value)
 
    If verif Is Nothing Then
    Sheets(1).Cells(a, 14).Value = Sheets(1).Cells(i, 9).Value
    texte = Sheets(1).Cells(i, 7).Value & Sheets(1).Cells(i, 8).Value & ", pourcentage PNR : " & PNR
    Sheets(1).Cells(a, 15).Value = texte
 
    Else
    texte = Sheets(1).Cells(verif.Row, 15).Value
    texte = texte & "; " & Sheets(1).Cells(i, 7).Value & Sheets(1).Cells(i, 8).Value & ", pourcentage PNR : " & PNR
    Sheets(1).Cells(verif.Row, 15).Value = texte
 
    End If
 
End If
Next i
 
End Sub

Ou autrement :

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
Sub essai()
 
Dim verif As Range, m As Range, dico As New Dictionary
y = Sheets(1).Range("I4:I" & Sheets(1).Range("I:I").End(xlDown).Row).Count
 
For j = 4 To y + 4
If Not dico.Exists(Sheets(1).Cells(i, 10).Value) Then
dico.Add Sheets(1).Cells(i, 10).Value, Sheets(1).Cells(i, 10).Value
PNRt = PNRt + Sheets(1).Cells(i, 10).Value
End If
Next i
 
For j = 4 To y + 4
 
a = Sheets(1).Range("N1:N" & Sheets(1).Range("N:N").End(xlDown).Row).Count + 1
 
Set m = Sheets(1).Range(Sheets(1).Cells(4, 3), Sheets(1).Cells(x + 4, 3)).Find(Sheets(1).Cells(j, 9).Value)
 
If m Is Nothing Then
PNR = 1 - (PNRt - Sheets(1).Cells(j, 10).Value) / PNRt
PNR = Format(PNR, "0.00%")
Set verif = Sheets(1).Range("N:N").Find(Sheets(1).Cells(j, 9).Value)
 
    If verif Is Nothing Then
    Sheets(1).Cells(a, 14).Value = Sheets(1).Cells(j, 9).Value
    texte = Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
    Sheets(1).Cells(a, 15).Value = texte
 
    Else
    texte = Sheets(1).Cells(verif.Row, 15).Value
    texte = texte & "; " & Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
    Sheets(1).Cells(verif.Row, 15).Value = texte
 
    End If
 
End If
 
Next j
 
End Sub

18/05/2016, 13h08
Mateos_hiss

lool la maniere dont tu reponds et spectaculaire , j'ai essayé cette nouvelle version mais ca bug au niveau du dico : user defined type not defined !!
18/05/2016, 13h18
Al__22

Haha oula loin de là il y a des personnes bien plus performantes que moi :mouarf::mouarf:

Pour ce qui est de ton erreur vérifie que dans ton projet VBA dans Outils => Références
Tu as Microsoft Scripting Runtime de cocher sinon tu le cherche dans la liste et tu le coche ^^
18/05/2016, 14h19
Mateos_hiss

AL__22 ton code est parfait je commence un peu a comprendre les dico lol , mais parcontre dans le resultat il me rend seulement une seul valeur cella de la ligne 7 , et je vois qu'il y a un probleme avec les boucle for qui font la loupe dans le dicto mais je vois pas comment corriger ce bug
!!

Ceci devrait corriger le problème :

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
Sub essai()
Dim verif As Range, m As Range, dico As New Dictionary
y = Sheets(1).Range("I4:I" & Sheets(1).Range("I:I").End(xlDown).Row).Count
 
For j = 4 To y + 4
If Not dico.Exists(Sheets(1).Cells(j, 10).Value) Then
dico.Add Sheets(1).Cells(j, 10).Value, Sheets(1).Cells(j, 10).Value
PNRt = PNRt + Sheets(1).Cells(j, 10).Value
End If
Next j
 
For j = 4 To y + 4
 
a = Sheets(1).Range("N1:N" & Sheets(1).Range("N:N").End(xlDown).Row).Count + 1
 
Set m = Sheets(1).Range(Sheets(1).Cells(4, 3), Sheets(1).Cells(y + 4, 3)).Find(Sheets(1).Cells(j, 9).Value)
 
If m Is Nothing Then
PNR = 1 - (PNRt - Sheets(1).Cells(j, 10).Value) / PNRt
PNR = Format(PNR, "0.00%")
Set verif = Sheets(1).Range("N:N").Find(Sheets(1).Cells(j, 9).Value)
 
    If verif Is Nothing Then
    Sheets(1).Cells(a, 14).Value = Sheets(1).Cells(j, 9).Value
    texte = Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
    Sheets(1).Cells(a, 15).Value = texte
 
    Else
    texte = Sheets(1).Cells(verif.Row, 15).Value
    texte = texte & "; " & Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
    Sheets(1).Cells(verif.Row, 15).Value = texte
 
    End If
 
End If
 
Next j
 
End Sub

J'avais oublié de mettre j à la place de i

18/05/2016, 15h33
Mateos_hiss

2 pièce(s) jointe(s)

re AL__22

je sais bien que je t'embete avec moi je suis desolé , j'ai essayé le nouveau code et il me retourne toujours le meme resultat Pièce jointe 210069 alors que le resultat doit etre a peu pret comme celui la Pièce jointe 210071 si t'as une idée ?
18/05/2016, 15h42
MacKay77

Al__22 les données commencent à la ligne 3, pas la ligne 4 :roll:
Bref pour commencer, faut remplacer les 4 par des 3 !
18/05/2016, 15h44
Mateos_hiss

oui j'ai changé ca mais comme meme ca retourn le meme resultat !
18/05/2016, 15h48
Al__22

Citation:

Envoyé par MacKay77

Al__22 les données commencent à la ligne 3, pas la ligne 4 :roll:
Bref pour commencer, faut remplacer les 4 par des 3 !

Chez moi c'était ligne 4 :mouarf:

Pour ce qui est de ton erreur Mateos la comme ça je vois pas chez moi ça marche très bien avec les même données que ce que tu montres... Je vais regarder

Voir 40 message(s) de cette discussion en une page