Mettre a jour un fichier excel par rapport à un autre

**david14120** · 16/04/2014, 23h28

Bonjour à tous,
Je suis nouveau sur le site et je m'intéresse de plus en plus au macro excel mais mes connaissances dans ce domaine sont pour le moment limitées.
Après plusieurs heures de recherches je ne trouve pas de solution à mon problème, c'est pourquoi je me tourne vers vous.
Ma demande.
J'utilise un fichier (nom du fichier : référence) que je dois mettre à jour régulièrement par rapport à un autre fichier (nom : MAJ articles). Mes fichiers font environ 3000 lignes pour 30 colonnes.
La clé de recherche est un N° d'article.

Mes attendus pour la macro :
* pour comparer les deux fichiers j'utilise comme clé le N° d'article.
* Le fichier «référence» contient plus de colonne que le fichier «maj articles».
* Si un N°article n'apparait plus dans le fichier «maj articles», je souhaite que la ligne comportant cette article dans le fichier référence soit surlignée en rouge.
* si un article est ajoute dans le fichier «maj articles», je souhaite que la ligne correspondant soit intégrée dans le fichier «référence».
* je souhaite que toutes les infos contenus dans les colonnes du fichiers «MAJ articles» soit reportées dans le fichier «référence» si des modifications ont été apportées. (il est possible qu'il n'y est qu'une colonne qui soit modifiée.

Voilà en gros les données de mon problème. Aujourd'hui pour m'en sortir j'utilise la recherche V, autant dire que j'y passe du temps.
J'ai trouvé sur internet un début de code qui met à jour un fichier par rapport à un autre mais il ne signale pas les suppressions d'articles et je ne comprend pas trop la macro pour la modifier.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub majModifAjout()
Set Susa = Sheets("Usa")
Set Sbd = Sheets("BD")
For Each c In Range(Susa.[A3], Susa.[A65000].End(xlUp))
p = Application.Match(c, Sbd.[A3:A1000], 0)
If Not IsError(p) Then
Sbd.Cells(2 + p, 3) = c.Offset(0, 2)
Else
Sbd.[A65000].End(xlUp).Offset(1, 0) = c
Sbd.[A65000].End(xlUp).Offset(0, 1) = c.Offset(0, 1)
Sbd.[A65000].End(xlUp).Offset(0, 2) = c.Offset(0, 2)
End If
Next c
End Sub

Bon j'arrête mon blablas, j'espère ne pas avoir été indigeste et j'attends vos réponses avec impatience.

Merci.
David

**david14120** · 18/04/2014, 00h44

Bonsoir,
Malheureusement mon sujet n'attire pas les foules.
Tant pis je continu ma démarche.
J'ai essayé de comprendre le code que j'ai trouvé sur le net pour mon cas et j'avoue être bloqué.
J'ai ajouté des commentaires dans le code pour essayer de comprendre le fonctionnement.
Si quelqu'un peut m'aider je suis preneur. J'ai bien conscience que ça ne correspond pas tout à fait à mes attentes mais ça à aumoins le mérite de me
faire progresser dans excel.
alors n'hésitez pas, j'attend vos commentaires.
Merci.

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
Sub MAJTAB()
'
' MAJTAB Macro
' MAJ DU PROGRAMME
'
Set Sprog = Sheets("PROGRAMME 4R21")
  Set Spiv = Sheets("PIVOT")
  'sprog ou spiv permet de ne pas ecrire le nom de l'onglet
 
  For Each c In Range(Sprog.[A3], Sprog.[A65000].End(xlUp))
  ' for each permet de faire une boucle. le c est une variable qui
'se trouve dans sprog entre A3 et la derniere ligne utilisée avec un maxi
' de 65000 lignes
    p = Application.Match(c, Spiv.[A3:A1000], 1)
'p est une seconde variable avec une fonction match qui permet
' de rechecher la variable c dans l'onglet spiv entre A3 et A1000. le 1 permet de ne
'pas rechercher la valeur exact. donc si je veux avoir exactement la même variable,
' je peux mettre 0 ??
 
 
    If Not IsError(p) Then
      Spiv.Cells(2 + p, 3) = c.Offset(0, 2)
' pour moi ça se complique.je ne comprend pas ce passage.
'a quoi correspond offset
 
    Else
      Spiv.[A65000].End(xlUp).Offset(1, 0) = c
      Spiv.[A65000].End(xlUp).Offset(0, 1) = c.Offset(0, 1)
      Spiv.[A65000].End(xlUp).Offset(0, 2) = c.Offset(0, 2)
      Spiv.[A65000].End(xlUp).Resize(1, 3).Interior.ColorIndex = 4
      ' je ne comprend pas non plus cette partie. la derniere ligne doit permettre de mettre en couleur une cellule
      'mais je ne sais paslaquelle
 
    End If
  Next c
 
'
End Sub

**Chtik** · 21/04/2014, 22h26

Bonjour,

Peut-être que ceci devrait t'aider.
C'est bien sur à adapter.

Chtik

**david14120** · 22/04/2014, 09h27

Bonjour,
Merci pour le lien, j'J'ai regardé la code, il correspond bien à mes attentes.
L'idée de remplacer toute la ligne au lieu rechercher seulement les cellules modifiées me paraît plus simple a gérer et certainement plus rapide.
Voici le code modifié pour correspondre à mes fichiers.

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
Sub MAJPROGRAMME()
'
' MAJPROGRAMME Macro
 
Dim Plage As Range, C As Range, Ligne As Variant
With Sheets("PIVOT")
    'on définit "Plage" comme la plage des cellules de la colonne A
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("PROGRAMME 4R21")
    'boucle sur les cellules de "Plage"
    For Each C In Plage
        'recherche de la ligne correspondant à la ligne de C
        'Equivalent de la fonction Excel EQUIV
        Ligne = Application.Match(C.Value, .[A:A], 0)
        'si on trouve cette ligne, c'est une modification
        If IsNumeric(Ligne) Then
 
                  'c'est une modification; on remplace la ligne
                .Cells(Ligne, 1).Resize(, 42).Value = C.Offset(, 0).Resize(, 42).Value
         Else
 
            'si on ne trouve pas d'égalité, c'est un ajout
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1)" trouve la première cellule vide en dessous
            'de la colonne A
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42)" représente les 42 cellules où
            ' vont être copiées les cellules à additionner
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42).Value = _
                C.Offset(, 0).Resize(, 42).Value
        End If
    Next C
End With
End Sub

Pour le moment, j'arrive à mettre à jour mon fichier programme. Maintenant je souhaite mettre en rouge les lignes supplémentaires de l'onglet
programme par rapport à l'onglet pivot. je pense que je peux utiliser une bonne partie du code pour rechercher les valeurs et les mettre en rouge plutôt que de les copier sur un autre fichier.

Je ne suis pas sur d'être clair dans mes explications, je regarde et reviens vers vous.

**david14120** · 22/04/2014, 10h43

J'ai essayé de mettre à jour la macro mais j'avoue être un peu bloqué.

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
Sub MAJPROGRAMME()
'
' MAJPROGRAMME Macro
 
Dim Plage As Range, C As Range, Ligne As Variant
Dim Reponse As Long
Reponse = MsgBox("Voulez vous lancer la mise à jour du programme ?", vbQuestion + vbYesNo)
If Reponse = vbYes Then
 
With Sheets("PIVOT")
    'on définit "Plage" comme la plage des cellules de la colonne A
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("PROGRAMME 4R21")
    'boucle sur les cellules de "Plage"
    For Each C In Plage
        'recherche de la ligne correspondant à la ligne de C
        'Equivalent de la fonction Excel EQUIV
        Ligne = Application.Match(C.Value, .[A:A], 0)
        'si on trouve cette ligne, c'est une modification
        If IsNumeric(Ligne) Then
 
                  'c'est une modification; on remplace la ligne
                .Cells(Ligne, 1).Resize(, 42).Value = C.Offset(, 0).Resize(, 42).Value
         Else
 
            'si on ne trouve pas d'égalité, c'est un ajout
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1)" trouve la première cellule vide en dessous
            'de la colonne A
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42)" représente les 42 cellules où
            ' vont être copiées les cellules à additionner
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42).Value = _
                C.Offset(, 0).Resize(, 42).Value
        End If
    Next C
 
End With
 
With Sheets("PROGRAMME 4R21")
    'on définit "Plage" comme la plage des cellules de la colonne A
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("PIVOT")
    'boucle sur les cellules de "Plage"
    For Each C In Plage
        'recherche de la ligne correspondant à la ligne de C
        'Equivalent de la fonction Excel EQUIV
        Ligne = Application.Match(C.Value, .[A:A], 0)
        'si on trouve cette ligne, je ne dois rien faire et continuer ma recherche jusqu'a trouve une valeur absente de l'onglet "pivot"
        If IsNumeric(Ligne) Then
 
                  'je ne sais pas quel code mettre pour lui dire de ne rien faire si je trouve ma valeur
 
         Else
         'si je trouve pas d'égalité, je souhaite mettre la cellule en rouge. Quel code utiliser ?
 
 
 
        End If
    Next C
 
End With
 
 
MsgBox "Le programme a été mise à jour", vbInformation
 Else
    MsgBox "Mise à jour du programme annulée", vbInformation
End If
 
End Sub

Première question, peux t-on ajouter deux morceaux de code l'un à la suite de l'autre ? Si oui doit-on utiliser une transition ?
Deuxième questions, je ne trouve pas de code pour que la macro ne fasse rien si elle trouve une égalité et au contraire quelle mette en couleur la cellule si il y a une valeur différente dans le fichier programme.

Merci de votre aide.

**Chtik** · 23/04/2014, 19h40

Salut David,

Est-ce ceci que tu cherches à faire ?

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
Sub MAJPROGRAMME()
'
' MAJPROGRAMME Macro
 
Dim Plage As Range, C As Range, Ligne As Variant
Dim Reponse As Long
Reponse = MsgBox("Voulez vous lancer la mise à jour du programme ?", vbQuestion + vbYesNo)
If Reponse = vbYes Then
 
With Sheets("PIVOT")
    'on définit "Plage" comme la plage des cellules de la colonne A
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("PROGRAMME 4R21")
    'boucle sur les cellules de "Plage"
    For Each C In Plage
        'recherche de la ligne correspondant à la ligne de C
        'Equivalent de la fonction Excel EQUIV
        Ligne = Application.Match(C.Value, .[A:A], 0)
        'si on trouve cette ligne, c'est une modification
        If IsNumeric(Ligne) Then
 
                  'c'est une modification; on remplace la ligne
                .Cells(Ligne, 1).Resize(, 42).Value = C.Offset(, 0).Resize(, 42).Value
         Else
 
            'si on ne trouve pas d'égalité, c'est un ajout
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1)" trouve la première cellule vide en dessous
            'de la colonne A
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42)" représente les 42 cellules où
            ' vont être copiées les cellules à additionner
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42).Value = _
                C.Offset(, 0).Resize(, 42).Value
        End If
    Next C
End With
 
With Sheets("PROGRAMME 4R21")
    'on définit "Plage" comme la plage des cellules de la colonne A
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("PIVOT")
    'boucle sur les cellules de "Plage"
    For Each C In Plage
        'recherche de la ligne correspondant à la ligne de C
        'Equivalent de la fonction Excel EQUIV
        Ligne = Application.Match(C.Value, .[A:A], 0)
        ' Recherche une Range C de la feuille Programme n'ayant pas de correspondance avec une Range de la feuille Pivot
        If IsNumeric(Ligne) = False Then
 
         'si on ne trouve pas d'égalité, on met va sur la feuille Programme, mettre la Range C en rouge
            With Sheets("PROGRAMME 4R21")
                C.Interior.ColorIndex = 3
            End With
        End If
    Next C
End With
 
 
MsgBox "Le programme a été mise à jour", vbInformation
 Else
    MsgBox "Mise à jour du programme annulée", vbInformation
End If
 
End Sub

A+

**david14120** · 23/04/2014, 22h43

Bonsoir Chtick,
Merci pour ton aide, c'est exactement ce que je recherché.
Si je peux encore abuser, je souhaite également mettre en couleur la range c que nous aurons inséré lors de la première partie de la macro. Les cellules sont insérée à la fin de la liste mais pour les retrouver facilement je souhaite que la cellule soit en vert.

J'ai essayé de modifier la macro en utilisant également C.interior.color mais c'est la cellule du fichier PIVOT qui se met en couleur et non celle du fichier programme. Je pense avoir insérer le code au mauvais endroit. Peux tu m'aider. j'ai mis à jour ton code pour l'exemple.
Merci de ton aide.

**Chtik** · 24/04/2014, 17h35

Bonjour,

Tu peux essayer comme ça si tu veux :

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
Sub MAJPROGRAMME()
'
' MAJPROGRAMME Macro
 
Dim Plage As Range, C As Range, Ligne As Variant
Dim Reponse As Long
Reponse = MsgBox("Voulez vous lancer la mise à jour du programme ?", vbQuestion + vbYesNo)
If Reponse = vbYes Then
 
With Sheets("PIVOT")
    'on définit "Plage" comme la plage des cellules de la colonne A
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("PROGRAMME 4R21")
    'boucle sur les cellules de "Plage"
    For Each C In Plage
        'recherche de la ligne correspondant à la ligne de C
        'Equivalent de la fonction Excel EQUIV
        Ligne = Application.Match(C.Value, .[A:A], 0)
        'si on trouve cette ligne, c'est une modification
        If IsNumeric(Ligne) Then
 
                  'c'est une modification; on remplace la ligne
                .Cells(Ligne, 1).Resize(, 42).Value = C.Offset(, 0).Resize(, 42).Value
         Else
 
            'si on ne trouve pas d'égalité, c'est un ajout
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1)" trouve la première cellule vide en dessous
            'de la colonne A
            '".Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42)" représente les 42 cellules où
            ' vont être copiées les cellules à additionner
            ' On met la première ligne vide en vert
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42).Interior.ColorIndex = 4
            'Puis on y met les valeurs
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 42).Value = _
                C.Offset(, 0).Resize(, 42).Value
        End If
    Next C
End With
 
With Sheets("PROGRAMME 4R21")
    'on définit "Plage" comme la plage des cellules de la colonne A
    Set Plage = .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("PIVOT")
    'boucle sur les cellules de "Plage"
    For Each C In Plage
        'recherche de la ligne correspondant à la ligne de C
        'Equivalent de la fonction Excel EQUIV
        Ligne = Application.Match(C.Value, .[A:A], 0)
        ' Recherche une Range C de la feuille Programme n'ayant pas de correspondance avec une Range de la feuille Pivot
        If IsNumeric(Ligne) = False Then
 
         'si on ne trouve pas d'égalité, on met va sur la feuille Programme, mettre la Range C en rouge
                C.Interior.ColorIndex = 3
        End If
    Next C
End With
 
 
MsgBox "Le programme a été mise à jour", vbInformation
 Else
    MsgBox "Mise à jour du programme annulée", vbInformation
End If
 
End Sub

Chtik

**david14120** · 24/04/2014, 23h30

Bonsoir Chtick,
Merci pour ton aide. Tout fonctionne parfaitement.
Grace à tes conseils j'ai pu améliorer mes connaissances sur les macro.
Bon j'ai encore du boulot si je veux à mon tour aider quelques personnes.
Au plaisir.
David

Mettre a jour un fichier excel par rapport à un autre [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager