Discussion :

[halaster08]

Bonjour,

J'ai trouver un code sur ce site http://boisgontierjacques.free.fr/pa...re.htm#MergeMZ qui permet de fusioner deux tableaux en utilisant un dictionnaire, je travaille sur l'adaptation de ce code pour résoudre mon problème et j'aurais bien besoin d'un coup de main.
L'exemple qui va avec ce code contient deux tableaux simple avec une colonne ID et une colonne VALEUR.
J'ai déjà réussi a adapter pour avoir plusieurs colonnes valeurs différentes et avoir plus que deux tableaux.
Le dernier problème qu'il me reste c'est pour la colonne contenant l'identifiant, j'aurais aimé utilisé plusieurs cellules pour identifier un element,pour l'instant je concactène toute mes colonnes et je fais l'opération inverse une fois la fusion finie, mais j'aurais aimé savoir si il était possible de se passer de cette étape.
Voici le code en question:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub fusion()
   Set d1 = CreateObject("Scripting.Dictionary")
   Set f1 = Sheets("ca2014")
   a = f1.Range("A2:B" & f1.[a65000].End(xlUp).Row)
   Set f2 = Sheets("ca2015")
   b = f2.Range("A2:B" & f2.[a65000].End(xlUp).Row)
   n = UBound(a) + UBound(b)
   Dim c: ReDim c(1 To n, 1 To 3)
   m = 0
   For i = LBound(a) To UBound(a)
     If Not d1.exists(a(i, 1)) Then m = m + 1: d1(a(i, 1)) = m: p = m Else p = d1(a(i, 1))
     c(p, 1) = a(i, 1): c(p, 2) = a(i, 2)
   Next i
   For i = LBound(b) To UBound(b)
     If Not d1.exists(b(i, 1)) Then m = m + 1: d1(b(i, 1)) = m: p = m Else p = d1(b(i, 1))
     c(p, 1) = b(i, 1): c(p, 3) = b(i, 2)
   Next i
   Sheets("fusion").[A2].Resize(d1.Count, UBound(c, 2)) = c
 End Sub

Mon problème se situe je pense au niveau du If Not d1.exists(a(i, 1)) que j'aimerais adapter pour prendre plusieurs cellules.

J'espère avoir été assez clair, merci d'avance à ceux qui essayeront de m'aider.

[joe.levrai]

Bonjour,

peux-tu préciser l'agencement de tes données ?

tu as combien de colonnes ? Combien (et quelles) colonnes constitueraient la clé ?

il faudra additionner chaque paire de colonnes ne constituant pas la clé ?


EDIT : en reprenant des tableaux de deux colonnes .... sans passer par un tableau et des indices intermédiaires lors du traitement

exemple avec deux tableaux de 3 lignes et 2 colonnes (A1:B3 et E1:E3)
affichage du résultat sur les colonnes H et I

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub tableau()
Dim A(), B()
Dim C As Object
Set C = CreateObject("Scripting.Dictionary")
 
A = Cells(1, 1).Resize(3, 2).Value
B = Cells(1, 5).Resize(3, 2).Value
 
For i = LBound(A, 1) To UBound(A, 1)
    If Not C.exists(A(i, 1)) Then C.Add A(i, 1), A(i, 2) Else C(A(i, 1)) = C(A(i, 1)) + A(i, 2)
Next i
 
For i = LBound(B, 1) To UBound(B, 1)
    If Not C.exists(B(i, 1)) Then C.Add B(i, 1), B(i, 2) Else C(B(i, 1)) = C(B(i, 1)) + B(i, 2)
Next i
 
Cells(1, 8).Resize(C.Count, 1).Value = Application.Transpose(C.keys)
Cells(1, 9).Resize(C.Count, 1).Value = Application.Transpose(C.items)
 
End Sub

Et une variante en une seule boucle imbriquée : on stocke tous les tableaux dans un tableau qu'on parcourt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub tableauDansArray()
Dim A(), B(), D()
Dim C As Object
Set C = CreateObject("Scripting.Dictionary")
 
A = Cells(1, 1).Resize(3, 2).Value
B = Cells(1, 5).Resize(3, 2).Value
D = Array(A, B)
 
For j = LBound(D) To UBound(D)
    For i = LBound(D(j), 1) To UBound(D(j), 1)
        If Not C.exists(D(j)(i, 1)) Then C.Add D(j)(i, 1), D(j)(i, 2) Else C(D(j)(i, 1)) = C(D(j)(i, 1)) + D(j)(i, 2)
    Next i
Next j
 
Cells(1, 8).Resize(C.Count, 1).Value = Application.Transpose(C.keys)
Cells(1, 9).Resize(C.Count, 1).Value = Application.Transpose(C.items)
 
End Sub

La variante est facilement modifiable pour ne pas utiliser le tableau B : on fait une boucle sur chaque feuille contenant un tableau, on stocke dans A, on parcours le tableau pour alimenter le dictionnaire

[halaster08]

tu as combien de colonnes ? Combien (et quelles) colonnes constitueraient la clé ?

Pour mes données ça peut varier suivant le détail des données qu'on me fourni.(à priori pour l'instant ce serait entre 4 et 8).

Mais pour l'exemple deux devraient suffire (colonnes A et B), je pense qui si on m'aide pour le faire avec deux colonnes je devraient pouvoir le faire pour plus.

il faudra additionner chaque paire de colonnes ne constituant pas la clé ?

Non c'est des colonnes distinctes (somme d'argents, nombre de dossier, texte ..)
pour l'exemple une seule colonne de valeur C

Donc on aurait en entrée deux tableaux avec deux colonnes (A et B) pour l'indentifiant et une (C) pour les données
Et en sortie un tableau avec deux colonnes (A et B) pour l'indentifiant et deux (C et D) contenant les données

En fait je doit reproduire un tableau de bord avec des données qui viennent de 4 bases différentes (et non je n'ai pas accès aux bases juste aux export excel), certains identifiant se retrouvent dans plusieurs export mais pas tous et il n'y pas d'export qui contient tous les identifiants, le meilleur moyen que j'ai trouvé pour aggréger le tout c'est ça, ça marche très bien et c'est super rapide mais j'ai juste le problème de l'identifiant sur plusieurs cellules (que j'aimerais contourner autrement que par concaténation).

edit: je m'excuse j'ai oublié le plus important, merci pour ton aide

[halaster08]

EDIT : en reprenant des tableaux de deux colonnes .... sans passer par un tableau et des indices intermédiaires lors du traitement

exemple avec deux tableaux de 3 lignes et 2 colonnes (A1:B3 et E1:E3)
affichage du résultat sur les colonnes H et I

retour après test de tes macros:

J'aimerais pourvoir utiliser plusieurs colonnes(2 pour l'instant) pour définir mon identifiant
Pas de sommes des valeurs
(mais ça c'est ma faute je n'ai pas répondu assez vite)
Par contre il y a un problème d'écrasement de données, je m'explique:
j'ai tester avec dans mon premier tableau id1 id2 id3 et dans le second id4 id1 id2 à la sortie je n'ai que id1 id2 id4, je pense que la ligne avec id4 a écrasé celle avec l'id3
edit je viens en chageant l'ordre du second tableaux id1 id2 id4 il ne me sort plus que id1 id2

[joe.levrai]

Je viens de refaire un test (macro "tableauDansArray()") avec comme jeu de données :

tableau 1 :

A 1
B 2
C 3

tableau 2 :

A 4
C 5
E 6

tableau résultat :

A 5
B 2
C 8
E 6

je n'ai pas d'écrasement de données, tu peux montrer le code que tu as utilisé ?


Ensuite, j'ai peur de ne plus saisir exactement ce que tu souhaites ... peux-tu transmettre un fichier exemple avec 2 tableaux de départ et le tableau d'arrivé souhaité ?

[patricktoulon]

Bonjour
j'ai cru comprendre que les doublons devaient être considérer sur plusieurs cellules
c'est a dire doublons sur colonne 1 et 2 sur les 2 plages si c'est le cas
http://www.developpez.net/forums/d13...bles-tableaux/

Ps j'avais fait ca pour ceux qui ont Excel 2003 et donc pas la fonction removeduplicate

[halaster08]

@joe.levrai
j'ai utiliser ton code à la virgule près en déplaçant quelques lignes de mes données
edit: je viens de réassayer et effectivement ça marche, alors que hier non... , mais ça ne change pas mon problème d'identifiant sur plusieurs lignes

pour l'exemple:
Désolé de ne pas être très clair

@patricktoulon
Merci pour le lien je vais aller voir, mais une chose me fait peur, tu parles de removeduplicate, et je ne veux rien supprimer au contraire
edit: je viens d'aller voir, comme sur l'exemple que j'avais trouvé ton identifiant est sur une seule colonne et tu utilise

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

mondico.Exists(tablo(i, 1))

Ce que j'aimerais faire c'est dans le "Exists" mettre une plage et pas un seul élément, mais je ne sais pas le faire.

J'espère avoir été un peu plus clair.
Et merci pour votre aide.

[boisgontierjacques]

Bonjour,

Exemple avec clé sur 2 colonnes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Dim d1, MaxLigT, Ncol, Tbl()
Sub Stat()
  Set d1 = CreateObject("Scripting.Dictionary")
  Set f1 = Sheets("données")
  Ncol = f1.[a1].CurrentRegion.Columns.Count
  ReDim Tbl(1 To 1000, 1 To Ncol)
  ligT = 1
  MaxLigT = ligT
  a = f1.[a1].CurrentRegion
  Totalise a
  b = f1.[a21].CurrentRegion
  Totalise b
  Set f2 = Sheets("résultats")
  f2.[a1] = f1.[a1]
  f1.[c1].Resize(, Ncol - 2).Copy f2.[b1]
  f2.[a2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
  f2.[B2].Resize(d1.Count, Ncol - 1) = Tbl
  f2.Activate
  [a1].CurrentRegion.Sort Key1:=Range("a2"), Header:=xlYes
End Sub
 
Sub Totalise(a)
  For ligne = 2 To UBound(a)
    crit = a(ligne, 1) & " " & a(ligne, 2)
    If d1.exists(crit) Then ligT = d1(crit) Else d1(crit) = MaxLigT: ligT = MaxLigT: MaxLigT = MaxLigT + 1
    For col = 3 To Ncol
      If a(ligne, col) <> "" Then Tbl(ligT, col - 2) = Tbl(ligT, col - 2) + a(ligne, col)
    Next col
  Next ligne
End Sub

Boisgontier

[joe.levrai]

Bonjour,

un autre exemple, qui est une adaptation de ma précédente proposition.

On concatène les identifiants dans les clés du dictionnaire et les valeurs dans les items du dictionnaire

à la fin, on remet tout en ordre grâce au séparateur inséré entre chaque élément

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 tableauDansArray()
Dim A(), B(), D()
Dim C As Object
Dim Sep As String
Sep = "!"
Set C = CreateObject("Scripting.Dictionary")
 
A = Cells(1, 1).CurrentRegion.Resize(, 3).Value
B = Cells(1, 5).CurrentRegion.Resize(, 3).Value
D = Array(A, B)
 
For j = LBound(D) To UBound(D)
    For i = LBound(D(j), 1) + 1 To UBound(D(j), 1)
        If Not C.exists(D(j)(i, 1) & Sep & D(j)(i, 2)) Then
            C.Add D(j)(i, 1) & Sep & D(j)(i, 2), D(j)(i, 3)
        Else
            C(D(j)(i, 1) & Sep & D(j)(i, 2)) = C(D(j)(i, 1) & Sep & D(j)(i, 2)) & Sep & D(j)(i, 3)
        End If
    Next i
Next j
 
With Cells(2, 9).Resize(C.Count, 1)
    .Value = Application.Transpose(C.keys)
    .TextToColumns Destination:=.Cells(1, 1), _
                                    DataType:=xlDelimited, _
                                    TextQualifier:=xlDoubleQuote, _
                                    Other:=True, _
                                    OtherChar:=Sep
End With
 
 
 
With Cells(2, 11).Resize(C.Count, 1)
    .Value = Application.Transpose(C.items)
    .TextToColumns Destination:=.Cells(1, 1), _
                                    DataType:=xlDelimited, _
                                    TextQualifier:=xlDoubleQuote, _
                                    Other:=True, _
                                    OtherChar:=Sep
End With
End Sub

[patricktoulon]

bonjour tu n'est pas allé assez loin dans la discution

sur un tazbleau de plusieur colonne je teste dans le dico du genre comme ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if dico.exists(tablo(i,1) & tablo(i,2) then....

bref je test si tablo(i,1 & (i,2)

[halaster08]

@patricktoulon
Tu vas surement encore me prendre pour un nul, mais quand je clic sur ton lien il n'y a qu'un seul message donc je ne sais pas aller plus loin, et sur ce message je n'avais pas vu la ligne dont tu parles.

@joe.levrai
La concaténation c'est ce que j'utilise actuellement, sauf que moi je m'embetais à rajouter une colonne de concaténation dans mon tableau, et je cherchais justement à me débarrasser de cet étape, je n'avais pas pensé a le faire directement dans la macro, c'est bien plus pratique comme ça je te remercie.

@boisgontierjacques
Merci pour ce second exemple, en le combinant avec l'autre que j'avais cité au début de ce post, j'arrive a faire ce que je veux.

MERCI encore pour votre aide, le problème est normalement résolu.

[halaster08]

@joe.levrai
Pour info, j'ai un petit soucis(screenshot plus bas) avec ton code (auquel je n'ai rien changé), si un item est uniquement dans le tableau 2, sa valeur n'est pas dans la bonne colonne (il doit manquer un &sep quelque part mais je ne vois pas où)(ou alors un décalage d'indice pour le placer).
Je vais donc repartir du code que j'avais et modifier les exist, ça marche sur un exemple simple, ça devrait donc marcher avec toutes mes données .



edit: une dernière question que je dois absolument te poser: pourquoi joe.LEVRAI ? Il y a un joe.lefaux ou un joe.lejumeaumaléfique ?

edit2: le code qui marche marche bien pour l'exemple simple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub fusion()
   Set d1 = CreateObject("Scripting.Dictionary")
   Set f1 = Sheets("Sheet1")
   A = f1.Range("A1:C3")
   Set f2 = Sheets("Sheet1")
   B = f2.Range("E1:G4")
   n = UBound(A) + UBound(B)
   Dim C: ReDim C(1 To n, 1 To 4)
   m = 0
   For i = LBound(A) To UBound(A)
   crit = A(i, 1) & " " & A(i, 2)
     If Not d1.exists(crit) Then m = m + 1: d1(crit) = m: p = m Else p = d1(crit)
     C(p, 1) = A(i, 1): C(p, 2) = A(i, 2): C(p, 3) = A(i, 3)
   Next i
   For i = LBound(B) To UBound(B)
    crit = B(i, 1) & " " & B(i, 2)
     If Not d1.exists(crit) Then m = m + 1: d1(crit) = m: p = m Else p = d1(crit)
     C(p, 1) = B(i, 1): C(p, 2) = B(i, 2): C(p, 4) = B(i, 3)
   Next i
   Sheets("Sheet1").[J1].Resize(d1.Count, UBound(C, 2)) = C
 End Sub

[patricktoulon]

re
bon c'est exotique
a tu déjà entendu parler de la fonction evaluate ??

aurais tu par hasard jeter un œil sur certaine de mes discussion récente du genre comment faire un tableau avec une chaine de caractères

si oui regarde dans le debug la chaine obtenu le reste tu trouvera tout seul
regarde bien j'ai pris une colonne en plus pour mon tableau 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Base 1
Sub test()
    Dim dico, plag(2), tabfinal
    Set dico = CreateObject("scripting.dictionary")
    plag(1) = Range("A1:c" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    plag(2) = Range("f1:i" & Cells(Rows.Count, "f").End(xlUp).Row).Value
     For i = 1 To 2
        tablo = plag(i)
        For e = 1 To UBound(tablo)
           If i = 2 Then tablo(e, 4) = "": tablo(e, 4) = tablo(e, 3): tablo(e, 3) = ""
                If Not dico.exists(tablo(e, 1) & tablo(e, 2)) Then
                dico(tablo(e, 1) & tablo(e, 2)) = tablo(e, 1) & "," & tablo(e, 2) & "," & tablo(e, 3)
                End If
                If i < 2 Then
                dico(tablo(e, 1) & tablo(e, 2)) = dico(tablo(e, 1) & tablo(e, 2))
                Else
                dico(tablo(e, 1) & tablo(e, 2)) = dico(tablo(e, 1) & tablo(e, 2)) & ",," & tablo(e, 4)
 
             End If
             Next
    Next
    For Each elem In dico
 
    tablostring = tablostring & Replace(dico(elem), ",,", ",") & ";"
    Next
    Debug.Print tablostring
    End Sub

c'est exotique j'avais prévenu hein !!!

[joe.levrai]

Je regarderai demain pour une autre proposition .... dès que j'aurai quelques minutes (journée ultra chargée).

joe.levrai ... parce qu'autrefois (à l'époque où on naviguais encore sur internet avec NetScape et autres anciennetés) j'étais joe et je ne croisais pas souvent des homonymes.

puis Internet s'est démocratisé et les joe ont proliféré, puis sont venus les piratages gratuits de comptes (on a tous été con à mal sécuriser un compte dans sa vie) ... ainsi joe.levrai naquit et ne changât.

[halaster08]

@patricktoulon

Non je connais pas evaluate, et j'ai pas vu la discussion dont tu parles, je n'ai pas le temps en ce moment de regarder des choses qui me demandent trop d'investissement, je viens pour mes soucis et je regarde au passage si y a des problèmes simple où je peut aider.

@joe.levrai

Prends ton temps, j'ai une version qui marche dont j'ai déjà posté le code pour l'exemple.
C'était juste pour info, au cas où toi ou quelqu'un qui lirait ce fil voudrait utiliser le code.

@tout le monde
Le code complet que j'utilise avec 8 colonnes d'identifiant, 5 tableaux de données et un nombre de colonnes différent par tableau, fait avec mes maigres connaissances à partir du premier exemple que j'avais cité et de l'aide qu'on ma fourni pour modifier le dico.exist
(Attention, il y a surement des choses à améliorer dans ce code, mais pour le moment je n'ai pas le temps et comme il est fonctionel ...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub fusion()
   Set dico = CreateObject("Scripting.Dictionary")
   Set f1 = Sheets("data1")
   Set f2 = Sheets("data2")
   Set f3 = Sheets("data3")
   Set f4 = Sheets("data4")
   Set f5 = Sheets("data5")
   A = f1.Range("A2:J" & f1.[a650000].End(xlUp).Row)
   B = f2.Range("A3:J" & f2.[a650000].End(xlUp).Row)
   C = f3.Range("A3:T" & f3.[a650000].End(xlUp).Row)
   D = f4.Range("A3:I" & f4.[a650000].End(xlUp).Row)
   G = f5.Range("A3:I" & f5.[a650000].End(xlUp).Row)
   n = UBound(A) + UBound(B) + UBound(C) + UBound(D) + UBound(G)
   Dim e: ReDim e(1 To n, 1 To 26)
   m = 0
   For i = LBound(A) To UBound(A)
   crit = A(i, 1) & " " & A(i, 2) & " " & A(i, 3) & " " & A(i, 4) & " " & A(i, 5) & " " & A(i, 6) & " " & A(i, 7) & " " & A(i, 8)
     If Not dico.exists(crit) Then m = m + 1: dico(crit) = m: p = m Else p = dico(crit)
     For k = 1 To 8
        e(p, k) = A(i, k)
     Next k
     e(p, 9) = A(i, 9): e(p, 10) = A(i, 10)
   Next i
   For i = LBound(B) To UBound(B)
   crit = B(i, 1) & " " & B(i, 2) & " " & B(i, 3) & " " & B(i, 4) & " " & B(i, 5) & " " & B(i, 6) & " " & B(i, 7) & " " & B(i, 8)
     If Not dico.exists(crit) Then m = m + 1: dico(crit) = m: p = m Else p = dico(crit)
     For k = 1 To 8
        e(p, k) = B(i, k)
     Next k
     e(p, 11) = B(i, 9): e(p, 12) = B(i, 10)
   Next i
   For i = LBound(C) To UBound(C)
   crit = C(i, 1) & " " & C(i, 2) & " " & C(i, 3) & " " & C(i, 4) & " " & C(i, 5) & " " & C(i, 6) & " " & C(i, 7) & " " & C(i, 8)
     If Not dico.exists(crit) Then m = m + 1: dico(crit) = m: p = m Else p = dico(crit)
     For k = 1 To 8
        e(p, k) = C(i, k)
     Next k
     e(p, 13) = C(i, 20): e(p, 14) = C(i, 13): e(p, 15) = C(i, 9): e(p, 16) = C(i, 10): e(p, 17) = C(i, 11): e(p, 18) = C(i, 12): e(p, 19) = C(i, 14): e(p, 20) = C(i, 15): e(p, 21) = C(i, 16): e(p, 22) = C(i, 17): e(p, 23) = C(i, 18): e(p, 24) = C(i, 19)
   Next i
   For i = LBound(D) To UBound(D)
   crit = D(i, 1) & " " & D(i, 2) & " " & D(i, 3) & " " & D(i, 4) & " " & D(i, 5) & " " & D(i, 6) & " " & D(i, 7) & " " & D(i, 8)
     If Not dico.exists(crit) Then m = m + 1: dico(crit) = m: p = m Else p = dico(crit)
     For k = 1 To 8
        e(p, k) = D(i, k)
     Next k
     e(p, 25) = D(i, 9)
   Next i
   For i = LBound(G) To UBound(G)
   crit = G(i, 1) & " " & G(i, 2) & " " & G(i, 3) & " " & G(i, 4) & " " & G(i, 5) & " " & G(i, 6) & " " & G(i, 7) & " " & G(i, 8)
     If Not dico.exists(crit) Then m = m + 1: dico(crit) = m: p = m Else p = dico(crit)
      For k = 1 To 8
        e(p, k) = G(i, k)
     Next k
     e(p, 26) = D(i, 9)
   Next i
   Sheets("Fusion").[A2].Resize(dico.Count, UBound(e, 2)) = e
 End Sub