comparaison et agrégation (macro-excel)

Version imprimable

Bonjour,
Je vous explique mon problème. Je travaille donc sous excel, en fait j'ai deux fichiers de données dans deux feuilles différentes avec une colonne commune. Ce que je souhaite réalisé c'est comparer ces deux colonnes et lorsque elle sont identiques copier les données de la deuxième feuille sur la première bien évidemment sur la ligne qu'elles ont en communes. J'ai réalisé une macro qui fonctionne sur quelques lignes mais pas sur mes données réelles.(1500 lignes)
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 Sub Comparer() Dim ws1 As Worksheet, ws2 As Worksheet, Maligne As Variant, Maligne2 As Variant, Macolonne As Variant, Macolonne2 As Variant, i2, i3, k, kk, z Set ws1 = Worksheets(1) Set ws2 = Worksheets(2) Set ws3 = Worksheets(3) Maligne = ws1.Range("A1").End(xlDown).Address Maligne = ws1.Range(Maligne).Row Maligne2 = ws2.Range("A1").End(xlDown).Address Maligne2 = ws2.Range(Maligne2).Row Macolonne = ws1.Range("A1").End(xlToRight).Address Macolonne = ws1.Range(Macolonne).Column Macolonne2 = ws2.Range("A1").End(xlToRight).Address Macolonne2 = ws2.Range(Macolonne2).Column With ws1 'on parcours la colonne dans la première feuille For k = 1 To Maligne z = .Range("A" & k) 'on parcours la colonne dans la deuxième feuille For kk = 1 To Maligne2 'on compare avec la valeur de la première feuille If ws2.Range("A" & kk) = z Then i3 = Macolonne 'on écrit les données correspondante For i2 = 2 To Macolonne2 i3 = i3 + 1 ws1.Cells(k, i3).Value = ws2.Cells(kk, i2).Value Next End If Next Next End With End Sub
Je pense que ce sont surement les 3 boucles imbriquées qui posent problème. En vous remerciant ;)
Bonne journée

08/04/2008, 15h44
Le Pierre

bonjour

j'ai testé sur le fichier joint. Ceci devrait répondre à ton problème
http://http://cjoint.com/?eipO4TJm7C
contacte moi si tu souhaites des éclaircissements
à plus

Et ceci ? (pas testé, et j'ai pas l'habitude de travailler avec des Range, mais bon...)
Par contre attention, il faut que la colonne "commune" ait des identifiants uniques, sinon... ça se complique.

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
 
Sub Comparer() 
Dim ws1 As Worksheet, ws2 As Worksheet, Maligne As Variant, Maligne2 As Variant, Macolonne As Variant, Macolonne2 As Variant, i2, i3, k, kk, z 
Set ws1 = Worksheets(1) 
Set ws2 = Worksheets(2) 
Set ws3 = Worksheets(3) 
Maligne = ws1.Range("A1").End(xlDown).Address 
Maligne = ws1.Range(Maligne).Row 
Maligne2 = ws2.Range("A1").End(xlDown).Address 
Maligne2 = ws2.Range(Maligne2).Row 
Macolonne = ws1.Range("A1").End(xlToRight).Address 
Macolonne = ws1.Range(Macolonne).Column 
Macolonne2 = ws2.Range("A1").End(xlToRight).Address 
Macolonne2 = ws2.Range(Macolonne2).Column 
With ws1 
'on parcours la colonne dans la première feuille 
For k = 1 To Maligne 
   z = ws1.Range("A" & k).Value 
   'on parcours la colonne dans la deuxième feuille 
   For kk = 1 To Maligne2 
      'on compare avec la valeur de la première feuille 
      If ws2.Range("A" & kk).Value = z Then 
         'i3 = Macolonne (ligne inutile)
         'on écrit les données correspondantes 
         For i2 = 2 To Macolonne2 
            'i3 = i3 + 1 (ligne inutile)
            ws1.Cells(k, i2).Value = ws2.Cells(kk, i2).Value 
         Next 
         Exit for 'inutile de continuer à boucler quand la correspondance a été trouvée
      End If 
   Next 
Next 
End With 
End Sub

Edit :
Je ne comprends pas bien ce que tu voulais faire avec la ligne :

Code:

i3 = Macolonne

Tu voulais rajouter les données de la feuille 2 à la suite de celles de la feuille 1 ? Ou tu préfèrerais les écraser (ce que fait mon code) ?

08/04/2008, 15h59
noobynoob

Citation:

Envoyé par neupont

Edit :
Je ne comprends pas bien ce que tu voulais faire avec la ligne :

Code:

i3 = Macolonne

Tu voulais rajouter les données de la feuille 2 à la suite de celles de la feuille 1 ? Ou tu préfèrerais les écraser ?

Bien vu, en fait je veux rajouter les données de la feuille 2 à la suite de la feuille 1. Les données de la première colonne sont des codes de commune d'une région(il y'en a 1500 et des brouettes) et la ligne que tu ne comprends pas en fait je réinitialise i3 pour me retrouvé à chaque fois à rajouter les données dans la même colonne. Je vais tester ta macro Le Pierre et je vous tiens au courant.
Merci pour vos réponse rapide
08/04/2008, 16h04
noobynoob

Arf ca ne marche pas, en fait sa donne le même résultat que ma macro, il copie juste la première ligne à la suite dans la feuille1 et il s'arrête la.
08/04/2008, 16h10
neupont

Un truc tout con, il faudrait sans doute mettre Next k et next kk, plutôt que next tout court. A part ça ta macro a l'air bien.

Edit : sans oublier next i2.
Tu devrais indenter ton code, quand on fait des boucles imbriquées c'est quand même plus clair.
08/04/2008, 16h21
noobynoob

Et bien nan j'ai rajouté les next k, kk et i2 et ta sortie de boucle. et toujours pareil il me copie que la première ligne, j'avoue que je comprends pas vu que sa marche sur un plus petit fichier... C'est à se tirer une balle...

Bizarre, quand je teste ton code à peine modifié avec ce qu'on a dit ça fonctionne chez moi (1600 lignes) :

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
 
Sub Comparer()
Dim ws1 As Worksheet, ws2 As Worksheet, Maligne As Variant, Maligne2 As Variant, Macolonne As Variant, Macolonne2 As Variant, i2, i3, k, kk, z
Set ws1 = Worksheets(1)
Set ws2 = Worksheets(2)
Set ws3 = Worksheets(3)
Maligne = ws1.Range("A1").End(xlDown).Address
Maligne = ws1.Range(Maligne).Row
Maligne2 = ws2.Range("A1").End(xlDown).Address
Maligne2 = ws2.Range(Maligne2).Row
Macolonne = ws1.Range("A1").End(xlToRight).Address
Macolonne = ws1.Range(Macolonne).Column
Macolonne2 = ws2.Range("A1").End(xlToRight).Address
Macolonne2 = ws2.Range(Macolonne2).Column
With ws1
'on parcours la colonne dans la première feuille
For k = 1 To Maligne
    z = .Range("A" & k)
    'on parcours la colonne dans la deuxième feuille
    For kk = 1 To Maligne2
        'on compare avec la valeur de la première feuille
        If ws2.Range("A" & kk) = z Then
            i3 = Macolonne
            'on écrit les données correspondante
            For i2 = 2 To Macolonne2
                i3 = i3 + 1
                ws1.Cells(k, i3).Value = ws2.Cells(kk, i2).Value
            Next i2
        Exit For
        End If
    Next kk
Next k
End With
End Sub

08/04/2008, 16h31
neupont

Par contre c'est très lent avec deux fois 1600 lignes... il y a certainement moyen de faire bien plus rapide avec la commande Find.

Bonjour tlm,

Ci-dessous le code un peu nettoyé

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
Sub Comparer()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig1 As Integer, Lig2 As Integer, Col2 As Integer
Dim i As Integer, k As Integer, kk As Integer
 
Set Ws1 = Worksheets(1)
Set Ws2 = Worksheets(2)
 
Lig1 = Ws1.Range("A1").End(xlDown).Row
Lig2 = Ws2.Range("A1").End(xlDown).Row
Col2 = Ws2.Range("A1").End(xlToRight).Column
 
For k = 1 To Lig1
   For kk = 1 To Lig2
      If Ws2.Cells(kk, 1) = Ws1.Cells(k, 1) Then
         For i = 2 To Col2
            Ws1.Cells(k, i) = Ws2.Cells(kk, i)
         Next
         GoTo suite
      End If
   Next
suite:
Next
End Sub

Je reviens avec une solution adoptant la fonction Find qui comme le dit très bien Neupont, sera bcp plus rapide

Ci-dessous le code avec la fonction Find

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Comparer()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig1 As Integer, Col2 As Integer ,k As Integer
 
Set Ws1 = Worksheets(1)
Set Ws2 = Worksheets(2)
 
Lig1 = Ws1.Range("A1").End(xlDown).Row
Col2 = Ws2.Range("A1").End(xlToRight).Column
 
 
 
For k = 1 To Lig1
    Set c = Ws2.Range("A:A").Find(what:=Ws1.Cells(k, 1), lookat:=xlWhole)
        If Not c Is Nothing Then
            Ws2.Range(Cells(c.Row, 2).Address & ":" & Cells(c.Row, Col2).Address).Copy Ws1.Cells(k, 2)
        End If
Next
End Sub

09/04/2008, 09h01
noobynoob

Le code avec la fonction Find marche nikel, seulement j'aimerais que les cellules que l'on copie soit écrit dans les premières colonnes vides dans la feuille 1. Parce que là sa m'écrase des données de la feuille1 que je souhaite conserver. Je suis en train de cherché mais j'essaye déjà de comprendre comment fonctionne Find.
Encore une fois merci à tous pour votre aide
09/04/2008, 09h07
noobynoob

Et ben voilà c'est bon suffit de trouvé la dernière colonne vide de la feuille 1 et de changé

Code:

Copy Ws1.Cells(k, 2)

en

Code:

Copy Ws1.Cells(k,Col1+1)

Merci bien

Re,

Essaye comme ceci pour inscrire les données dans les colonnes vides, en supposant que toutes tes lignes ont le même nombre de colonne comportant des données

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Comparer()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig1 As Integer, Col1 As Integer, Col2 As Integer, k As Integer
 
Set Ws1 = Worksheets(1)
Set Ws2 = Worksheets(2)
 
Lig1 = Ws1.Range("A1").End(xlDown).Row
Col1 = Ws2.Range("A1").End(xlToRight).Offset(0, 1).Column
Col2 = Ws2.Range("A1").End(xlToRight).Column
 
 
 
For k = 1 To Lig1
    Set c = Ws2.Range("A:A").Find(what:=Ws1.Cells(k, 1), lookat:=xlWhole)
        If Not c Is Nothing Then
            Ws2.Range(Cells(c.Row, 2).Address & ":" & Cells(c.Row, Col2).Address).Copy Ws1.Cells(k, Col1)
        End If
Next
End Sub

Edit : oui ta solution est bonne aussi ;)