Macro: lien entre 2 feuilles

Licorne

XLDnaute Nouveau
Bonsoir

Je rencontre une difficulté à mettre en place une macro pour détecter les ligne qui n'existent pas et de les rajouter à mon tableau.

Tous les jours je reçois un tableau excel avec plusieurs milliers de lignes, face à ce tableau je suis obliger de faire le tri. Je doit également vérifier l'ensembles des éléments de la ligne (référence, prix, quantité, numéro de boite, etc...)
Très fastidieux car la vérification se fait sur un catalogue papier.

Donc j'essaye depuis un moment de mettre en place une macro qui me permet à partir de:

Dans la Feuil1 mettre une macro dans les cellules de la col A, qui me permet de comparer avec la Feuil2 Col A, et en cas d'absence de de la référence de la rajouter dans la Feuil2 ainsi que sa ligne en même temps, et de marquer la ligne rajouter par une couleur afin de la détecter facilement et commencer la modification des autres éléments.

En revanche je doit conserver les références qui existent dans les deux feuilles (ne pas modifier les doublons)

En ce qui concerne les lignes qui existent dans la Feuil2 et qui ne sont pas dans la Feuil1 je souhaite les marquer par une autre couleur.

J'ai essayé avec filtre élaboré mais ca marche pas trop !!

Un très grand merci pour votre aide.

Zammi
 

Theze

XLDnaute Occasionnel
Re : Macro: lien entre 2 feuilles

Bonjour,

Teste ce qui suit sur une copie de ton classeur pour voir si ça convient. Adapte le nom des feuilles si pas "Feuil1" et "Feuil2" :
Code:
Sub Reference()

    Dim PlageFE_1 As Range
    Dim PlageFE_2 As Range
    Dim CelFE_1 As Range
    Dim CelFE_2 As Range
    Dim DerCel As Long
    
    'défini les plages en colonne A de Feuil1 et Feuil2
    With Worksheets("Feuil1")
    
        Set PlageFE_1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    
    End With
    
    With Worksheets("Feuil2")
    
        Set PlageFE_2 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
        
        'mémorise la dernière ligne occupée
        DerCel = .Cells(.Rows.Count, 1).End(xlUp).Row
        
    End With
    
    'boucle sur la plage en Feuil1 et recherche la valeur en Feuil2
    'si pas trouvée, rajoute la ligne à Feuil2 puis colore (cellules non vides) en rouge
    For Each CelFE_1 In PlageFE_1
    
        Set CelFE_2 = PlageFE_2.Find(CelFE_1, , xlValues, xlWhole)
        
        If CelFE_2 Is Nothing Then
        
            DerCel = DerCel + 1
            
            With Worksheets("Feuil2")
            
                CelFE_1.EntireRow.Copy .Range("A" & DerCel)
                .Range(.Cells(DerCel, 1), .Cells(DerCel, .Columns.Count).End(xlToLeft)).Interior.ColorIndex = 3
                
            End With
            
        End If
        
    Next CelFE_1
    
    'boucle sur la plage en Feuil2 et recherche la valeur en Feuil1
    'si pas trouvée, colore la ligne (cellules non vides) en jaune
    For Each CelFE_2 In PlageFE_2
    
        Set CelFE_1 = PlageFE_1.Find(CelFE_2, , xlValues, xlWhole)
        
        If CelFE_1 Is Nothing Then
        
            With Worksheets("Feuil2")
            
                .Range(.Cells(CelFE_2.Row, 1), .Cells(CelFE_2.Row, .Columns.Count).End(xlToLeft)).Interior.ColorIndex = 6
                
            End With
            
        End If
        
    Next CelFE_2

End Sub

Hervé.
 

Licorne

XLDnaute Nouveau
Re : Macro: lien entre 2 feuilles

Merci Hervé,

Un petit dysfonctionnement quant à la boucle sur la Feuil2 qui colore l'ensemble des valeurs qu'elle trouve dans les deux feuilles en jaune et pas que les valeurs non trouvées dans la Feuil1.

Exemple:
Feuil1 / Feuil2 / Couleur
1 / 1 / Jaune
2 / 3 / Jaune
3 / 5 / Jaune
4 / 10/ Jaune
5 / 12/ Jaune
- / 2 / Rouge
- / 4 / Rouge

Donc en ce qui concerne la première partie ça fonctionne parfaitement, pour la seconde je n'arrive pas repérer les références qui ne font plus parti de la Feuil1.
Est'il possible au lieux de les marquer par une couleur les supprimer de la Feuil2 également?

Merci d'avance pour votre aide.
 

Theze

XLDnaute Occasionnel
Re : Macro: lien entre 2 feuilles

Re,

Bizarre, car chez moi ça fonctionne bien :
Code:
'boucle sur la plage en Feuil2 et recherche la valeur en Feuil1
'si pas trouvée, colore la ligne (cellules non vides) en jaune
For Each CelFE_2 In PlageFE_2

    Set CelFE_1 = PlageFE_1.Find(CelFE_2, , xlValues, xlWhole)
    
    If CelFE_1 Is Nothing Then
    
        With Worksheets("Feuil2")
        
            .Range(.Cells(CelFE_2.Row, 1), .Cells(CelFE_2.Row, .Columns.Count).End(xlToLeft)).Interior.ColorIndex = 6
            
        End With
        
    End If
    
Next CelFE_2
Dans le code ci-dessus, on cherche bien la valeur de la cellule en cours (cellule dans la plage parcourue en Col A de la feuille "Feuil2") qui peut se trouver dans la plage en Feuille "Feuil1" (colonne A), si pas trouvé (CelFE_1 = Nothing) alors on colore en jaune.
Pour mon test, j'ai mis deux valeurs en colonne A de Feuil2 qui ne se trouvent pas en colonne A de Feuil1 et seulement ces deux lignes sont colorées en jaune et non toutes les lignes ???
Si cela t'es possible, poste ton classeur que je puisse voir.

Hervé.
 

Theze

XLDnaute Occasionnel
Re : Macro: lien entre 2 feuilles

Re,

Oui, tu peux supprimer les lignes dont la cellule en colonne A est vide.
Tu peux mettre cette ligne de code juste après avoir défini la plage de la feuille "Feuil2" afin d'épurer la plage (dans le bloc With Worksheets("Feuil2") End With).
Après suppression, la plage est automatiquement redimensionnée donc, pas besoin de la redéfinir :
Code:
With Worksheets("Feuil2")

    Set PlageFE_2 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    
    'supprime les lignes dont la cellule en colonne A est vide
    PlageFE_2.SpecialCells(4).EntireRow.Delete
    
    'mémorise la dernière ligne occupée
    DerCel = .Cells(.Rows.Count, 1).End(xlUp).Row
    
End With

Hervé.
 

Licorne

XLDnaute Nouveau
Re : Macro: lien entre 2 feuilles

Merci Hervé !!!

Ça à merveille, j'ai du également modifier la plage de la Col A à la Col B.
Seul bémol, dès que je lance la macro dans mon tableau de plus de 3000 ligne, la boucle est lancé mais ça dur une éternité et à chaque fois je suis obligé d'arrêter la macro.
Avez-vous une solution à ce problème?
Merci beaucoup pour votre aide.
 

Discussions similaires

Statistiques des forums

Discussions
312 165
Messages
2 085 882
Membres
103 009
dernier inscrit
dede972