Suppression de doublons et calculs

Version imprimable

Saut tout le monde,

J'ai un tableau 2D ressemblant à :

cle1 4
cle2 3
cle3 7
cle2 1
cle4 10
cle4 6

J'aimerais faire en sorte d'avoir :

cle1 4
cle2 4
cle3 7
cle4 16

Donc supprimer les lignes avec une clé doublon mais additionner sa valeur avec la première... Je sais que c'est pas dur, que je devrais trouver mais ce n'est pas le cas.

Pour l'instant j'ai ceci :
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 Dim cle() Redim cle(Ubound(Tab3,1)) m=0 ok=0 n=0 For i=0 to Ubound(Tab3,1) Do While cle(m) <> Tab3(i,0) AND m < Ubound(Tab3,1) m=m+1 Loop If cle(m) = Tab3(i,0) Then For a=m to Ubound(Tab3,1)-1 For b=0 to Ubound(Tab3,2) Tab3(a,b)=Tab3(a+1,b) Next Next ok=1 End If If ok=0 Then cle(n)=Tab3(i,0) n=n+1 End If m=0 ok=0 Next
Avez vous des idées ? Merci d'avance ;)

Edit : ce code m'affiche une liste sans doublon mais supprime certaines valeurs, sur 2200 lignes originales, dont 1550 sans doublons, il m'en affiche que 1422

14/06/2013, 12h20
Cachlab

Bonjour Stalex,

Je pense que la problématique des doublons appelle l'utilisation de dictionnaires.
Je n'ai pas trop de temps pour me pencher sur ta question mais j'espère que ça t'aidera.
++

Bonjour,

Comme le dit CachLab, l'utilisation de dictionnaire parait toute indiquée pour répondre à la problématique.
Implémentation possible :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Set objKeysDictionnary = CreateObject("Scripting.Dictionary") 'Création du dictionnaire contenant les clés
objKeysDictionnary.CompareMode = 1 'Mode de comparaison : texte
For i=0 to Ubound(Tab3,1) ' Pour chaque occurence du tableau Tab3
	If objKeysDictionnary.Exists(Tab3(i,0)) Then
		objKeysDictionnary.Item(Tab3(i,0)) = objKeysDictionnary.Item(Tab3(i,0)) + Tab3(i,1) 'Si la clé a déjà été trouvée, ajout des valeurs
	Else
		objKeysDictionnary.Add(Tab3(i,0), Tab3(i,1)) 'Sinon ajout de la clé au dictionnaire
	End If
Next
For Each strKey In objKeysDictionnary.Keys 'Pour chaque clé contenue dans le dictionnaire
	WScript.Echo strKey & ";" & objKeysDictionnary.Item(strKey) 'Affichage de la clé et de la valeur
Next

Bonne continuation

14/06/2013, 13h19
Invité

Merci à vous deux, je vais me pencher sur les dictionnaires.

Concernant ton code pitchalov, j'ai malheureusement une erreur :

L'appel d'une fonction Sub n'admet pas de parenthèses
objobjKeysDictionnary.Add(Tab3(i,0), Tab3(i,1)) 'Sinon ajout de la clé au dictionnaire

Hmm :(
14/06/2013, 14h12
pitchalov

Bonjour,

Possibilité de coquilles, je n'ai pas testé le code. C'était juste pour donner un exemple "dans l'esprit" de la problématique.
Essaie donc sans les parenthèses :

Code:

objKeysDictionnary.Add Tab3(i,0), Tab3(i,1)

Bonne continuation
14/06/2013, 14h41
Invité

Merci beaucoup pitchalov, j'ai comme résultat :
4HREX699500CZZZZZPZZZZZ 00

Où 4HREX699500CZZZZZPZZZZZ est la clé et 0 et 0 les valeurs de la clé qui existe en 2 exemplaires.

Me reste donc à les additionner au lieu de les ajouter :)

Je regarde ça
14/06/2013, 14h46
Invité

J'ai une dernière question dans mon exemple la clé n'avait qu'une valeur.

Or dans mon vrai fichier j'ai :

clé1 val1 val2
clé2 val3 val4
clé3 val5 val6
clé3 val7 val8
clé2 val9 val10

Et donc je veux :

clé1 val1 val2
clé2 val3+val9 val4+val10
clé3 val4+va7 val5+val8

C'est possible avec ta manière pitchalov ?
Merci encore ;)

Bonjour,

Il semblerait que tes nombres soient vus comme des strings dans ton tableau.
Une solution peut être :

Code:

objKeysDictionnary.Item(Tab3(i,0)) = objKeysDictionnary.Item(CInt(Tab3(i,0)) + CInt(Tab3(i,1)))

Pour gérer plus de valeurs, je suppose que c'est possible, mais il va falloir être plus explicite car tu parles de fichiers quand dans ton code tu travailles avec des tableaux.
Comme ça peut-être?
Code:

1 2 3 4 5 If objKeysDictionnary.Exists(Tab3(i,0)) Then objKeysDictionnary.Item(Tab3(i,0)) = objKeysDictionnary.Item(CInt(Tab3(i,0)) + CInt(Tab3(i,1)) + CInt(Tab3(i,2))) Else objKeysDictionnary.Add Tab3(i,0), CInt(Tab3(i,1)) + CInt(Tab3(i,2)) End If
Au final, ce n'est que de l'adaptation à ce que tu veux faire.

Bonne continuation

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
53
54
55
Dim Tab4()
ReDim Tab4(Ubound(Tab3,1),13)
 
Dim fsot, ft   
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("C:\Users\Monique\Downloads\lololololololo.txt", 2,true)
 
Set objKeysDictionnary = CreateObject("Scripting.Dictionary") 'Création du dictionnaire contenant les clés
objKeysDictionnary.CompareMode = 1 'Mode de comparaison : texte
For i=0 to Ubound(Tab3,1) ' Pour chaque occurence du tableau Tab3
	If objKeysDictionnary.Exists(Tab3(i,0)) Then
		objKeysDictionnary.Item(Tab3(i,0)) = objKeysDictionnary.Item(Tab3(i,0)) + Tab3(i,1) 'Si la clé a déjà été trouvée, ajout des valeurs
	Else
		objKeysDictionnary.Add Tab3(i,0), Tab3(i,1) 'Sinon ajout de la clé au dictionnaire
	End If
Next
i=0
 
For Each strKey In objKeysDictionnary.Keys 'Pour chaque clé contenue dans le dictionnaire
	Tab4(i,0)=strKey
	i=i+1
Next
Redim Preserve Tab3(Ubound(Tab3,1),13) ' pour le bon nombre de colonnes
 
For i=0 to Ubound(Tab3,1)
	For j=0 to Ubound(Tab4,1)
		If Tab4(j,0)=Tab3(i,0) Then
			Tab4(j,1)=Tab4(j,1)+Tab3(i,1)
			Tab4(j,2)=Tab4(j,2)+Tab3(i,2)
			Tab4(j,3)=Tab4(j,3)+Tab3(i,3)
			Tab4(j,4)=Tab4(j,4)+Tab3(i,4)
			Tab4(j,5)=Tab4(j,5)+Tab3(i,5)
			Tab4(j,6)=Tab4(j,6)+Tab3(i,6)
			Tab4(j,7)=Tab4(j,7)+Tab3(i,7)
			Tab4(j,8)=Tab4(j,8)+Tab3(i,8)
			Tab4(j,9)=Tab4(j,9)+Tab3(i,9)
			Tab4(j,10)=Tab4(j,10)+Tab3(i,10)
			Tab4(j,11)=Tab4(j,11)+Tab3(i,11)
			Tab4(j,12)=Tab4(j,12)+Tab3(i,12)
		End If
	Next
Next	
 
m=0
For i=0 to UBound(Tab4,1) ' copie de tab3 dans le fichier et marche
	For j=0 to UBound(Tab4,2)
		If m < UBound(Tab4,2) Then 
			ft.write(Tab4(i,j) & "	")
			m=m+1
		Else
			ft.write(Tab4(i,j) & vbcrlf)
			m=0
		End If
	Next
Next

Mon code marche quasiment. Quand j’additionne les cases qui ont la même clé et même colonne, ça donne :

4HREX699500CZZZZZPZZZZZ 00 00 27599,410 0-5112,28 00 00 00 00 00 00 00 00

Au lieu de :

4HREX699500CZZZZZPZZZZZ 0 0 27599,41 -5112,28 0 0 0 0 0 0 0 0

Ca rajoute juste les valeurs les unes après les autres sans les calculer :(

17/06/2013, 10h26
pitchalov

Bonjour,

Pourquoi continues-tu à utiliser des tableaux après avoir initialisé le dictionnaire? Du coup l'utilisation d'un dictionnaire dans ton code t'est (presque) inutile, si tu ne t'en sers pas.

Je pense que mon précédent post apporte pas mal de réponses aux questions que tu te poses toujours.

Sinon je ne comprends pas ce que tu essaies de faire, globalement.
Donc je ne saurais pas t'aider plus : le code que tu donnes n'est pas complet, on ne sait pas ce que contient le tableau "Tab3" avec lequel on travaille, à partir de là je ne devinerai pas à tatons son format et son contenu.

Bonne continuation

Le dictionnaire me permet juste de connaitre les clés uniques de mon tableau Tab3. C'est beaucoup plus rapide de cette manière que de faire des boucles avec un tableau temporaire pour connaitre les clés uniques. (je passe de 22sec à 1sec grâce à ton dico :) )

Voici mon code en entier :

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
Const ForReading = 1, ForWriting = 2 
Dim oFso, f
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
ln=-1
cl=0
 
while Not f.AtEndOfStream '1ère itération pour définir les limites du tableau
  ln=ln+1 'définition indice lignes
  Tab=Split(f.ReadLine,";")
  If cl < UBound(Tab) Then cl = UBound(Tab) 
Wend
f.Close
'MsgBox "indice lignes : " & ln+1 & "indice colonnes :" & cl+1
 
Dim Tab2()
ReDim Tab2(ln,cl)
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
i=0
while Not f.AtEndOfStream ' 2ème itération pour remplir le tableau Tab2
  Tab = Split(f.ReadLine,";")
  For j = 0 to UBound(Tab)
    Tab2(i,j) = Tab(j)
  Next
  i=i+1
Wend
f.Close
 
Dim Tab3()
ReDim Tab3(ln-1,cl)
 
For i=1 to UBound(Tab2,1) ' copie tout de tab2 à tab 3 sauf 1ere ligne marche
	For j=0 to Ubound(Tab2,2)'oui		
		Tab3(i-1,j)=Tab2(i,j)'oui
	Next 
Next
 
For i=0 to UBound(Tab3,1) ' on copie dans tab3 les clé dans la première colonne de chaque ligne
	For j=0 to Ubound(Tab3,2)
		Tab3(i,0)=Tab3(i,3)+Tab3(i,5)+Tab3(i,6)+Tab3(i,9)
	Next
Next 
 
For i=0 to Ubound(Tab3,1) ' on décale tous les mois vers la gauche
	For j=1 to Ubound(Tab3,2)-20
		Tab3(i,j)=Tab3(i,j+20)
	Next
Next
 
Dim fsot, ft   
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("C:\Users\Monique\Downloads\lololololololo.txt", 2,true)
 
Set objKeysDictionnary = CreateObject("Scripting.Dictionary") 'Création du dictionnaire contenant les clés
objKeysDictionnary.CompareMode = 1 'Mode de comparaison : texte
For i=0 to Ubound(Tab3,1) ' Pour chaque occurence du tableau Tab3
	If objKeysDictionnary.Exists(Tab3(i,0)) Then
		objKeysDictionnary.Item(Tab3(i,0)) = objKeysDictionnary.Item(Tab3(i,0)) + Tab3(i,1) 'Si la clé a déjà été trouvée, ajout des valeurs
	Else
		objKeysDictionnary.Add Tab3(i,0), Tab3(i,1) 'Sinon ajout de la clé au dictionnaire
	End If
Next
 
i=0
 
For Each strKey In objKeysDictionnary.Keys 'Pour chaque clé contenue dans le dictionnaire
	i=i+1
Next
 
Dim Tab4()
ReDim Tab4(i-1,13)
 
i=0
 
For Each strKey In objKeysDictionnary.Keys 'Pour chaque clé contenue dans le dictionnaire
	Tab4(i,0)=strKey
	i=i+1
Next
 
For i=0 to Ubound(Tab3,1)
	For j=0 to Ubound(Tab4,1)
		If Tab4(j,0)=Tab3(i,0) Then
			Tab4(j,1)=Tab4(j,1)+Tab3(i,1)
			Tab4(j,2)=Tab4(j,2)+Tab3(i,2)
			Tab4(j,3)=Tab4(j,3)+Tab3(i,3)
			Tab4(j,4)=Tab4(j,4)+Tab3(i,4)
			Tab4(j,5)=Tab4(j,5)+Tab3(i,5)
			Tab4(j,6)=Tab4(j,6)+Tab3(i,6)
			Tab4(j,7)=Tab4(j,7)+Tab3(i,7)
			Tab4(j,8)=Tab4(j,8)+Tab3(i,8)
			Tab4(j,9)=Tab4(j,9)+Tab3(i,9)
			Tab4(j,10)=Tab4(j,10)+Tab3(i,10)
			Tab4(j,11)=Tab4(j,11)+Tab3(i,11)
			Tab4(j,12)=Tab4(j,12)+Tab3(i,12)
		End If
	Next
Next	
 
m=0
Redim Preserve Tab4(Ubound(Tab4,1),13) ' pour le bon nombre de colonnes
For i=0 to UBound(Tab4,1) ' copie de tab3 dans le fichier et marche
	For j=0 to UBound(Tab4,2)
		If m < UBound(Tab4,2) Then 
			ft.write(Tab4(i,j) & "	")
			m=m+1
		Else
			ft.write(Tab4(i,j) & vbcrlf)
			m=0
		End If
	Next
Next

Et le fichier CSV contient 34 colonnes, x lignes. J'en ai 12 qui correspondent à des mois.
La première ligne est les titres des colonnes (dont je n'ai pas besoin et que je supprime en passant de tab2 à tab3).

Les clés sont l'addition (de string) de 4 colonnes. Elles sont au début en plusieurs exemplaires, et vu que je les veux en un seul exemplaire, j'utilise ton dico pour créer dans Tab4 un tableau avec que des clés uniques. Et mon dernier souhait : vu que mes clés sont en plusieurs exemplaires, je veux par exemple additioner que toutes les valeurs de janvier qui ont la même clé ;)

17/06/2013, 14h42
pitchalov
Bonjour,

Je ne comprends toujours pas trop mais à la limite c'est pas trop grave tant que ça te convient. Pareil pour le dictionnaire sous-utilisé par rapport à ton besoin mais de la même manière c'est toi qui vois.

Donc pour ton problème de concaténation, comme je te l'ai dit plus tôt, je pense que ton tableau contient des strings (et non pas des nombres) et qu'il faut les forcer en numérique pour que l'addition se fasse :
Code:

1 2 3 4 5 6 7 For j=0 to Ubound(Tab4,1) If Tab4(j,0)=Tab3(i,0) Then Tab4(j,1)=CInt(Tab4(j,1))+CInt(Tab3(i,1)) Tab4(j,2)=CInt(Tab4(j,2))+CInt(Tab3(i,2)) '... End If Next
Ca répond à ton problème?

Bonne continuation