XL 2013 Macro qui compare deux listes

océanne

XLDnaute Occasionnel
Bonsoir le forum,

Je vous sollicite car j'ai essayé ce soir de réaliser la macro suivante, mais je suis trop limitée.
Je ne joins pas de fichier car je pense que les explications ci-dessous devraient suffire, si ce n'est pas le cas, me le dire, je mettrai un classeur en PJ.

Je souhaiterais comparer deux listes de noms, contenues dans deux feuilles différentes d'un même classeur.

- une dans la colonne C de la feuille1
- l'autre dans la colonne A de la feuille2 (de nouveaux noms y sont ajoutés régulièrement)

Tous les noms contenus dans la colonne C de la feuille1 sont déja renseignés dans la colonne A de la feuille2, par contre, dans la colonne A de la feuille 2, de nouveaux noms sont ajoutés régulièrement, non pas tout en bas de la liste, mais de façon aléatoire dans la colonne.

mon objectif serait de détecter quelles sont les nouvelles valeurs contenues dans la colonne A de la feuille 2, qui ne sont pas dans la colonne C de la feuille1 et de venir les coller tout en bas de la liste dans la colonne C de la feuille1, une fois ces valeurs collées si possible les mettre sur fond de cellule jaune ou autre couleur afin de bien distinguer qu'elles sont nouvelles.

D'avance merci pour votre aide.
Océanne.
 

Softmama

XLDnaute Accro
Bonjour,

Voyez l'exemple en PJ qui devrait répondre à votre demande.

Ce code à placer dans le module de la feuil2 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Target  'chaque modif est regardée
  If c.Column = 1 And c <> "" And IsError(Application.Match(c, Feuil1.Range("C:C"), 0)) Then
    'si modif dans la colonne A, qu'il y a un contenu qui n'est pas dans la feuille1, colonne C
    With Feuil1.Range("C1000000").End(xlUp).Offset(1)
      .Value = c  'On ajoute la valeur changée à la feuille 1
      .Interior.ColorIndex = 6 'on colorie en jaune
    End With
  End If
Next
End Sub

Fichier en PJ.
 

Pièces jointes

  • Test_XL.xlsm
    15.4 KB · Affichages: 20

océanne

XLDnaute Occasionnel
Merci pour votre réactivité Softmama, ça marche très bien dans votre classeur. Un détail, je ne souhaite pas que ça soit une macro évenementielle, je préfère la piloter directement depuis un bouton...du coup comment dois-je corriger "ByVal Target as Range" car quand je la mets dans un module, ça bug ?
Bon dimanche
Océanne
 

laurent950

XLDnaute Accro
Bonsoir @océanne

VB:
Sub test()
Dim F1, F2 As Worksheet
    Set F1 = Worksheets("Feuil1")
    Set F2 = Worksheets("Feuil2")
Dim Tf1, Tf2 As Variant
    Tf1 = F1.Range(F1.Cells(1, 3), F1.Cells(F1.Cells(65536, 3).End(xlUp).Row, 3))
    Tf2 = F2.Range(F2.Cells(1, 1), F2.Cells(F2.Cells(65536, 1).End(xlUp).Row, 1))
        ReDim Preserve Tf2(LBound(Tf2, 1) To UBound(Tf2, 1), LBound(Tf2, 2) To 2)
Dim Flag As String: Flag = "Vrai"
    For i = LBound(Tf1, 1) To UBound(Tf1, 1)
        For j = LBound(Tf1, 1) To UBound(Tf1, 1)
            If Tf1(i, 1) = Tf2(j, 1) Then
                Tf2(j, 2) = Flag
            End If
        Next j
    Next i
Dim Tnews() As String
ReDim Tnews(1 To 1)
    For i = LBound(Tf2, 1) To UBound(Tf2, 1)
        If Tf2(i, 1) <> Empty And Tf2(i, 2) = Empty Then
            Tnews(UBound(Tnews)) = Tf2(i, 1)
            ReDim Preserve Tnews(1 To UBound(Tnews) + 1)
        End If
    Next i
ReDim Preserve Tnews(1 To UBound(Tnews) - 1)
    With F1.Cells(F1.Cells(65536, 3).End(xlUp).Row + 1, 3).Resize(UBound(Tnews))
        .Resize(UBound(Tnews)) = Application.Transpose(Tnews)
        .Interior.Pattern = xlSolid
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 13434879
        .Interior.TintAndShade = 0
        .Interior.PatternTintAndShade = 0
        .Font.Color = -4165632
        .Font.TintAndShade = 0
    End With
End Sub
 

Softmama

XLDnaute Accro
Bonjour Océanne, Laurent950 :)

Dans la continuité de ma première proposition, à placer dans un module normal et à lancer quand vous en avez besoin :
VB:
Sub Go_Filter()
Dim Valeurs()
Valeurs = Feuil2.Range("A1:A" & Feuil2.Range("A1000000").End(xlUp).Row) 'récupération des données de la feuil2


For t = LBound(Valeurs) To UBound(Valeurs) 'On les checke une à une
  If Valeurs(t, 1) <> "" And IsError(Application.Match(Valeurs(t, 1), Feuil1.Range("C:C"), 0)) Then 'Si pas déjà présente en feuil1 alors...
    With Feuil1.Range("C1000000").End(xlUp).Offset(1)
      .Value = Valeurs(t, 1)  'On l'ajoute à la fin
      .Interior.ColorIndex = 6 'en jaune
    End With
  End If
Next
End Sub

le fichier modifié en PJ
 

Pièces jointes

  • Test_XL.xlsm
    16.6 KB · Affichages: 15

océanne

XLDnaute Occasionnel
Laurent950, Softmama, le forum bonjour,

Merci beaucoup pour ce complément Laurent950 et Softmama, vos deux versions fonctionnent très bien, je suis à la cible. J'ai une petite préférence pour le code de Softmama qui pour une novice comme moi est à mes yeux plus simple à interpréter.

Bon dimanche à tous.
O.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 852
dernier inscrit
dthi16088