Tableau - Comparaison entre 2 fichiers excel

**backx3** · 01/10/2015, 10h13

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 :

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
    '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

Si vous voulez plus d'explication, demandez.

Merci d'avance

**Daniel.C** · 01/10/2015, 10h55

Bonjour,

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 ?

**backx3** · 01/10/2015, 11h29

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

**Daniel.C** · 01/10/2015, 13h05

Essaie :

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
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

**SfJ5Rpw8** · 03/10/2015, 18h22

Bonjour,

une autre solution en utilisant 2 collections d'objets pour mémoriser les numéros de lignes...

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
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

**backx3** · 05/10/2015, 09h18

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

Tableau - Comparaison entre 2 fichiers excel

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager