Doublons entre 2 fichiers

**jojo_peter** · 03/12/2008, 17h03

Bonjour le forum

Je suis en train de chercher une macro pour comparer 2 fichiers (A et B) et trouver les doublons. Les 2 fichiers sont ouvert
Le résultat doit s'afficher dans le fichier A sous forme de tableau.
Les 2 fichiers A et B contiennent chacun un tableau. La macro parcours les 2 tableaux, compare et donne le résultat.
Si les 2 tableaux sont dans le même fichier, ça colle un peu près

J'ai commencé a faire ça :

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
 
 
Public Sub doublons()
Dim i3
 
Set tab1 = Sheets(1).Range("A1").CurrentRegion
Set tab1 = tab1.Offset(1, 0).Resize(tab1.Rows.Count - 1, _
    tab1.Columns.Count)
Set tab2 = Sheets(1).Range("F2").CurrentRegion
Set tab2 = tab2.Offset(1, 0).Resize(tab2.Rows.Count - 1, _
    tab2.Columns.Count)
For Each cel1 In tab1
    val1 = cel1.Value
    For Each cel2 In tab2
        val2 = cel2.Value
        If val1 = val2 Then        
            Range("q1" & i3) = cel2
            i3 = i3 + 1
        End If     
    Next cel2
    Next cel1
End Sub

Je sais que je peux utiliser la commande
Set Wb2 = Workbooks("b.xls")

mais c'est pour ma boucle ou je galère sévère.

Quelqu'un pourrait il me venir en aide SVP ?

**zandru** · 04/12/2008, 09h05

Bonjour et bienvenu sur le forum,

Pour commencer, il manque les définitions de cel1 et cel2 :

Code :

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

dim cel1 as Cell

par exemple.

Par contre, peux-tu nous dire ce qui fonctionne déjà, si cela plante et où, ...
Bref un peu plus de détail sur tes bugs.

**jojo_peter** · 04/12/2008, 20h59

Merci !!

Alors, j'ai fait ça :

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
 
Option Explicit
Private cel1 As Range
Private cel2 As Range
Private tab1 As Range
Private tab2 As Range
Private val1 As Long
Private val2 As Long
 
 
 
Public Sub doublons()
Dim i3
 
Dim Wb1 As Workbook
Dim Wb2 As Workbook
 
'Définit les classeurs (supposés ouverts)
Set Wb1 = Workbooks("a.xls")
Set Wb2 = Workbooks("b.xls")
 
 
Workbooks("b.xls").Activate
 
Set tab1 = Sheets(1).Range("A1").CurrentRegion
Set tab1 = tab1.Offset(1, 0).Resize(tab1.Rows.Count - 1, _
    tab1.Columns.Count)
Set tab2 = Wb2.ActiveSheet.Range("A2").CurrentRegion
Set tab2 = tab2.Offset(1, 0).Resize(tab2.Rows.Count - 1, _
    tab2.Columns.Count)
For Each cel1 In tab1
    val1 = cel1.Value
    For Each cel2 In tab2
 
        val2 = cel2.Value
        If val1 = val2 Then       
           MsgBox (cel2) 
        End If
 
    Next cel2
 
Next cel1
 
 
End Sub

Le problème c que la boucle ne compare pas les valeurs identiques (entre les 2 fichiers) mais m'indique uniquement les valeurs du tableau du fichier B.
Pour tester plus facilement, je demande juste grâce a une Message Box de me renvoyer les info.
Je désire malgré tout écrire par la suite dans le fichier A (disons colonne M) mes fichiers en commun entre le tableau du fichier A et celui du fichier B.

J'espère que je suis clair dans ma demande ...

**SilkyRoad** · 05/12/2008, 19h56

bonsoir

Tu peux tester cette procédure :
le deuxième classeur doit être actif .

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
Sub ListeDoublonsDeuxTableaux()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Cell As Range
Dim Cible As Range
Dim Tableau()
Dim X As Byte, Y As Byte, Z As Byte, i As Byte
Dim Resultat As String, FirstAddress As String
 
'Définit les classeurs (supposés ouverts)
Set Wb1 = Workbooks("Classeur1.xls")
Set Wb2 = Workbooks("Classeur2.xls")
 
'Boucle sur les données de la feuille active dans le premier classeur
For Each Cell In Wb1.ActiveSheet.Range("A1:A10")
    Z = 0
 
    'Effectue la recherche dans le deuxième classeur
    With Wb2.ActiveSheet.Range("A1:A20")
        Set Cible = .Find(Cell, LookIn:=xlValues, lookAt:=xlWhole)
        'Si une donnée est trouvée
        If Not Cible Is Nothing Then
 
            FirstAddress = Cible.Address
            X = X + 1
            ReDim Preserve Tableau(1 To 2, 1 To X)
 
            Do
                Cible.Select
                Z = Z + 1
                Set Cible = .FindNext(After:=ActiveCell)
            'Recherche d'autres données identiques
            Loop While Not Cell Is Nothing And _
                Cible.Address <> FirstAddress
 
            'Alimente le tableau de résultat
            Tableau(1, X) = Cible
            Tableau(2, X) = Z
            Y = Y + Z
        End If
    End With
Next Cell
 
'affiche le résultat de la comparaison
Resultat = "Il y a " & Y & " données communes entre les deux tableaux  . " _
    & Chr(10) & Chr(10)
For i = LBound(Tableau(), 2) To UBound(Tableau(), 2)
Resultat = Resultat & Tableau(1, i) & Chr(9) & _
    Tableau(2, i) & " fois" & Chr(10)
Next i
 
MsgBox Resultat
End Sub

bonne soirée
michel

**jojo_peter** · 05/12/2008, 21h05

Merci SilkyRoad pour cette procédure, c'est effectivement ce que je cherchais.

Cependant, si je voulais inscrire le resultat des données communes sur la colonne F de fichier A, comment dois je procéder ?

Code :

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

Wb1.Range("F1" & i) = cible

Encore une question, comment se fait il que pour une meme macro, en faisant des tests sur le code, il peut y avoir un code erreur 1004 generé, et des fois pas ? Je jette mon excel par la fenetre ?