Tableau - Comparaison entre 2 fichiers excel

Version imprimable

Bonjour ! Malgré toutes mes recherches, je n'ai pas trouvé de solution à mon problème.. J'espère que vous pourrez m'aider :?

Je vous explique :

J'ai un fichier "x" contenant plusieurs colonnes et des milliers de lignes, et un fichier y similaire mais mis à jour régulièrement, et il doit mettre à jour le fichier x en fonction des nouvelles données.
Pour faire la comparaison des lignes des deux fichiers (elles sont toutes dans le désordre), je dois prendre 3 critères (colonnes A,B,C par exemple pour les comparer).

J'aimerais faire un tableau en VBA avec en colonne "A" les lignes du fichier "x", et en colonne "B", les lignes correspondantes à celles du fichier "x".
Si, dans le fichier "x", il y a une ligne qui n'a pas de correspondance dans le fichier "y", on va mettre un "?" dans la colonne "B" du tableau.

Exemple :

Ligne_Fichier_x -----------------Ligne_Corespondante_Dans_Le_Fichier_Y
1------------------------------------------------22
2------------------------------------------------125
3------------------------------------------------ ?
4------------------------------------------------12345
5------------------------------------------------55555

Mon code pour l'instant.....
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 'Pour chaque ligne du x, on regarde si il y a une correspondance dans y Workbooks("x.xlsm").Activate 'Détermine la dernière ligne de la colonne A pour les deux fichiers LigneMaxX = Sheets("Jalons").Range("A65536").End(xlUp).Row Workbooks("EQM_jalons_-_2_mois_bacASable.xlsx").Activate LigneMaxY = Sheets("planEQM_TCR").Range("A65536").End(xlUp).Row '---------DECLARATION DU TABLEAU---------------' Dim tab_ij() As String Dim i As Integer, j As Integer For i = 1 To LigneMaxX valeur = Cells(i, 1) valeur1 = Cells(i, 2) Valeur2 = Cells(i, 3) j = 1 Do While valeur <> Cells(j, 1) Or valeur <> Cells(j, 2) Or valeur <> Cells(j, 3) j = j + 1 If j > LigneMaxY Then Exit Do End If Loop If j = LigneMaxY + 1 Then NumLigne(i) = "x" Next
Ca fait depuis hier que je suis bloqué là dessus :triste:

Si vous voulez plus d'explication, demandez.

Merci d'avance

01/10/2015, 10h55
Daniel.C

Bonjour,

Citation:

J'aimerais faire un tableau en VBA avec en colonne "A" les lignes du fichier "x", et en colonne "B", les lignes correspondantes à celles du fichier "x".

"les lignes du fichier x" : chaque ligne contient 3 colonnes, pareil pour le fichier y. Comment tout mettre en colonnes A et B ?
01/10/2015, 11h29
backx3

Non il y a plus de 3 colonnes, mais on ne se sert que de 3 pour savoir si une ligne du fichier y est la même que celle du fichier x.
Si c'est la même, alors on met le numéro de la ligne qui correspond dans la colonne B.

En gros, les 3 colonnes servent juste pour la comparaison d'une ligne.
Est-ce assez clair ? :?

Merci pour ton intérêt à mon problème en tout cas ;)

Essaie :

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
Sub test()
    Dim sh As Worksheet, TablX As Variant, TablY As Variant, Plage As Range, C As Range, Result()
    Dim Ctr As Long, Teste As Boolean, I As Long, J As Long, K As Long
    With Workbooks("x.xlsm").Sheets("Jalons")
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
        Plage.Resize(, 1).Offset(, 3).Formula = "=row()"
        ReDim Result(Plage.Rows.Count - 1, 1)
    End With
    With ThisWorkbook.Sheets(1)
        .Cells.ClearContents
        Plage.Copy
        ThisWorkbook.Sheets(1).[A1].PasteSpecial xlPasteValues
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 4)
        Plage.Resize(, 1).Offset(, 3).Formula = "=row()"
        Plage.Value = Plage.Value
        Plage.Sort .[A1], xlAscending, .[B1], , xlAscending, .[C1], xlAscending, Header = xlNo
        TablX = Plage
    End With
    With Workbooks("y.xlsm").Sheets(1)
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
        Plage.Resize(, 1).Offset(, 3).Formula = "=row()"
    End With
    With ThisWorkbook.Sheets(1)
        .Cells.ClearContents
        Plage.Copy
        ThisWorkbook.Sheets(1).[A1].PasteSpecial xlPasteValues
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 4)
        Plage.Resize(, 1).Offset(, 3).Formula = "=row()"
        Plage.Value = Plage.Value
        Plage.Sort .[A1], xlAscending, .[B1], , xlAscending, .[C1], xlAscending, Header = xlNo
        TablY = Plage
        Ctr = -1
        K = 1
        For I = 1 To UBound(TablX, 1)
            Teste = False
'            If TablX(i, 1) = 15 Then Stop
            For J = K To UBound(TablY, 1)
                If TablX(I, 1) = TablY(J, 1) And TablX(I, 2) = TablY(J, 2) And TablX(I, 3) = TablY(J, 3) Then
                    Ctr = Ctr + 1
                    Result(Ctr, 0) = TablX(I, 4)
                    Result(Ctr, 1) = TablY(J, 4)
                    Teste = True
                    K = I
                    Exit For
                End If
            Next J
            If Teste = False Then
                Ctr = Ctr + 1
                Result(Ctr, 0) = TablX(I, 4)
                Result(Ctr, 1) = "?"
            End If
        Next I
        .Cells.ClearContents
        .[A1].Resize(UBound(TablX, 1) + 1, 2) = Result
    End With
End Sub

Bonjour,

une autre solution en utilisant 2 collections d'objets pour mémoriser les numéros de 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
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
Option Explicit
'
'
Sub Comparaison()
 
Dim oCol1 As Collection  'Collection
Dim oCol2 As Collection  'Collection
Dim sh1 As Worksheet 'Feuille 1 à comparer
Dim sh2 As Worksheet 'Feuille 2 à comparer
Dim shR As Worksheet 'Feuille Resultat
 
' On utilise par la suite les objets feuilles de calcul sh1,sh2 et shR
' A toi d'ouvrir les classeurs concernées et d'affecter chacun de ces 3 objets aux bonnes feuilles ..
'
Set sh1 = ThisWorkbook.Worksheets("Feuil1")
Set sh2 = ThisWorkbook.Worksheets("Feuil2")
Set shR = ThisWorkbook.Worksheets("Feuil3")
 
 
'Pour les 2 fichier "rempli" une collection avec un élément par ligne..
'Lecture feuille 1
LectureCollection sh1, oCol1
'Lecture feuille 2
LectureCollection sh2, oCol2
 
Debug.Print "Fin Lecture  fichier 1 : " & oCol1.Count & " lignes / Fichier 2 : " & oCol2.Count
 
'Création rapport
Dim r As Range
Dim j As Integer ' ligne dans fichier résultat
j = 2
Dim stTag As String
'Parcours collection 1 et met en colonne 1
For Each r In oCol1
    stTag = r.Cells(1, 1) & r.Cells(1, 2) & r.Cells(1, 3)
    shR.Cells(j, 1) = stTag 'Met le tag en colonne 1 du fichier résultat
    shR.Cells(j, 2) = r.Row 'Met numéro de ligne fichier 1 en colonne 2 du fichier résultat
    If ObjetEstDansCollection(stTag, oCol2) Then
           shR.Cells(j, 3) = oCol2(stTag).Row 'Met le numéro de ligne du fichier 2 dans colonne 3
        Else
            shR.Cells(j, 3) = "?" ' aJoute un point d'interrogation si n'existe pas ..
    End If
    j = j + 1
Next
'---------------------
' Cas ou présent en fichier 2 et pas dans fichier 1
For Each r In oCol2
    stTag = r.Cells(1, 1) & r.Cells(1, 2) & r.Cells(1, 3)
    If Not ObjetEstDansCollection(stTag, oCol1) Then
        shR.Cells(j, 1) = stTag 'Met le tag en colonne 1 du fichier résultat
        shR.Cells(j, 3) = r.Row 'Met numéro de ligne fichier 2 en colonne 3 du fichier résultat
        shR.Cells(j, 2) = "?" ' aJoute un point d'interrogation si n'existe pas ..
        j = j + 1
    End If
 
Next
 
End Sub
'
' Parcours feuille donnée en paramétre pour mettre à jour collection
' utilise comme repére la concaténation des 3 premiéres colonnes du fichier
'
Sub LectureCollection(sh As Worksheet, ByRef oCol As Collection)
Dim i As Integer
Dim stTag As String
Set oCol = New Collection 'initialise collection
i = 2
While sh.Cells(i, 1) <> ""
     stTag = sh.Cells(i, 1) & sh.Cells(i, 2) & sh.Cells(i, 3) ' Concaténe les colonnes A,B,C
     If Not ObjetEstDansCollection(stTag, oCol) Then
        oCol.Add sh.Rows(i), stTag
      Else
        Debug.Print "Erreur feuille : " & sh.Name & " ligne : " & i
        Debug.Print "Tag : " & stTag & " déjà présent ligne : " & oCol(stTag).Row
        Stop ' Voir message dans fenêtre exécution (CTRL+G ) puis actionner F5 pour continuer
      End If
    i = i + 1 'passage à ligne suivante
Wend
 
 
End Sub
 
 
 
 
'
' Test existance objet dans une collection..
'
Function ObjetEstDansCollection(ByVal stItem As String, oCol As Collection) As Boolean
  On Error Resume Next
    ObjetEstDansCollection = IsObject(oCol(stItem))
End Function

05/10/2015, 09h18
backx3

Merci à tous les deux pour vos réponses, je suis tombé sur un autre projet, je pourrais me remettre là dedans la semaine prochaine.

Est-ce que je dois mettre "Résolu" ?

En tout cas merci encore pour vos réponses, je regarderais ça de plus près :)
05/10/2015, 10h59
danixdb

1 pièce(s) jointe(s)

Bonjour Backx3, Le Forum,

En réponse à ta question, je te propose cette solution en VBA.

Slts