Discussion :

[majdi_bgmr]

bonjour à tous

j'ai 2 tableaux excel qui viennent de la même base de donnés (une extraction en Mai et l'autre en Avril )
et pour comparer les 2 tableaux, j'aimerai les mettre dans 1 seul tableau qui contient toute les lignes de la nouvelle extraction + les anciens valeurs de l ancienne extraction et leurs différence pour trouver facilement toutes les changement et les mise à jour. (y a nouveaux lignes dans la nouvelle extraction qui n’existent pas à l'ancienne dés coût les colonnes de références sont pas le mémé ordres !!!)

les 2 tableaux ont des colonnes communes ( nom projet, code fiche...) mais ils sont pas dans le même ordres
en PJ un extrait de mes 2 tableaux avec le 3 tableau
exmple.xlsx
Si vous pouvez m 'aider a faire une macro que me permet de fusionner les 2 tableaux pour gagner de temps (les tableaux contient plus que 5000 lignes)
c'est vraiment urgent pour moi et j'avance plus depuis 4 jours !!

si vous pouvez m'aider à trouver une solution SVP !
merci d avance pour votre participation et votre réponse

[patricktoulon]

Bonjour
j'ai regardé ton fichier et il semblerait que pour toi le moyen de comparaison soit la colonne nom fiche moe(H)
est tu d'accords avec ca ?

[Invité]

ici on compare les onglets par doublon. ce qui étaient avant et qui n'existe plus ou modifié
et ce qui est ou modifié maintenant.

j'ai enfin adopté le dictionary cher à Patrick il est vrai que c'est beaucoup mieux

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
 
Sub test()
Dim Init As Boolean
Dim WsAvant As Worksheet
Dim WSApres As Worksheet
Dim WsActif As Workbook
Dim C As Long
Dim L As Long
Dim L2 As Long
Dim newWs As Worksheet
Dim R As Range
'Récupère les information utiles.
Set WbActif = ActiveWorkbook
Set WsAvant = WbActif.Worksheets("ancienne extraction")
Set WSApres = WbActif.Worksheets("Nouvelle extraction ")
Set newWs = WbActif.Worksheets.Add(After:=WbActif.Worksheets(WbActif.Worksheets.Count))
newWs.Name = Format(Date, "yyyy-mm-dd")
L = 1
newWs.Cells(L, 1) = "Avant"
L = L + 1
For C = 1 To WsAvant.UsedRange.Columns.Count
    newWs.Cells(L, C) = WsAvant.Cells(1, C)
    MyColor newWs.Cells(L, C)
Next
Set R = WSApres.UsedRange
For L2 = 2 To R.Rows.Count
    Highlander Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))
Next
Set R = WsAvant.UsedRange
For L2 = 2 To R.Rows.Count
    If Highlander(Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))) = False Then
        L = L + 1
        For C = 1 To R.Columns.Count
            newWs.Cells(L, C) = R(L2, C)
        Next
    End If
Next
Init = False
For L2 = 2 To R.Rows.Count
    Highlander Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))
Next
L = L + 1
newWs.Cells(L, 1) = "Après"
L = L + 1
For C = 1 To WsAvant.UsedRange.Columns.Count
    newWs.Cells(L, C) = WsAvant.Cells(1, C)
    MyColor newWs.Cells(L, C)
Next
Set R = WSApres.UsedRange
For L2 = 2 To R.Rows.Count
    If Highlander(Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))) = False Then
        L = L + 1
        For C = 1 To R.Columns.Count
            newWs.Cells(L, C) = R(L2, C)
 
        Next
    End If
Next
Set WbActif = Nothing
Set WsAvant = Nothing
Set WSApres = Nothing
Set newWs = Nothing
MsgBox "Fin "
End Sub
Sub MyColor(R As Range)
    Range("A2").Select
    With R.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
End Sub
Function Highlander(Init, ParamArray Plage())
'..................................................
'La méthode Highlander, il ne peut en rester qu'un.
'Retourne True si doublon.
'..................................................
 
Static CollectDoublon
Dim t
Dim PlageIndex
Dim myPlage As Range
Dim Col As Integer
Dim Tableau
If Init = False Then
Init = True
Set CollectDoublon = Nothing
Set CollectDoublon = CreateObject("scripting.dictionary")
End If
 
 
t = "T"
For PlageIndex = 0 To UBound(Plage)
If TypeName(Plage(PlageIndex)) = "Range" Then
Set myPlage = Plage(PlageIndex)
 
For Col = 1 To myPlage.Columns.Count
Debug.Print Trim("" & myPlage(1, Col))
'myPlage(1, Col).Select
t = t & "_" & Trim("" & myPlage(1, Col))
Next
Else
If TypeName(Plage(PlageIndex)) = "Variant()" Then
Tableau = Plage(PlageIndex)
Else
If TypeName(Plage(PlageIndex)) Like "*()" Then
Tableau = Plage(PlageIndex)
Else
Tableau = Split(Plage(PlageIndex) & ";", ";")
End If
End If
For Col = 0 To UBound(Tableau)
t = t & "_" & Trim("" & Tableau(Col))
Next
End If
Next
Highlander = CollectDoublon.exists(Trim("" & t))
CollectDoublon(Trim("" & t)) = Trim("" & t)
End Function

[patricktoulon]

salut durupt cher ...; non il est gratuit pour tout le monde

néanmoins je trouve ton code un peu barbare pour une simple comparaison de 2 colonne voir même plus

moi avec 2 variable tableau j'aurais intégré la valeur d'une colonne servant de cle avec le row comme item dans le dico pas très cher
et pareil pour le 2 eme puisque l'intégration dans le dico fait le tri automatiquement dans la colonne 2 du dico tu aurai eu toute les ligne a transféré

sinon encore simple

Code :

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

1
2
3
4
tablo1=sheets("source").range........
tablo2=sheets("moteur").range........
 
comparaison des 2 en se servant d'un dico juste comme vérificateur tout simplement je l'avais expliquer a jijie je crois

code largement plus court ,rapidité

Au plaisir

[Invité]

néanmoins je trouve ton code un peu barbare pour une simple comparaison de 2 colonne voir même plus
sinon encore simple

code largement plus court ,rapidité

Au plaisir

Bonjour Patrick,
J’avoue que je n'avais pas vue que le fichier était joint, je suis parti sur quelque chose de plus générique qui ouvre compare et referme 2 fichier XLS.
Après j'ai cuisiné pour donner le piètre résultat et ta remarque est grandement justifier un rouleau compresseur pour écraser une fourmi.

mais je l'ai mis quand même ce qui est en fait idiot!

[patricktoulon]

loin de moi l'intention de dénigrer ton travail mais comme il semble être débutant sa risque d'être compliqué pour lui

j'avais fait une contrib il y a quelque temps déjà qui faisait exactement la même chose que remove duplicate en vba
pour les utilisateur de 2003 avec utilisation de dico et tableaux pour travailler sur plusieurs colonnes
avec prise en charge adaptable des colonnes comme la fonction removeduplicate de 2007

il suffirait de faire 2 ou 3 petite adaptations et le tour serait joué

il colle les 2 tableaux a la suite et hop un coup de remove duplicate


je recherche le lien et je vous le donne

Voila c'est ICI!!!!