Comparaison + Extraction ép. 2

Tibogn

XLDnaute Nouveau
Bonjour à tous !

J'ai déjà lancé une discussion sur la comparaison de données et l'extraction magnifiquement résolue. Je remercie encore pierrejean et CISCO de leur aide.

Je suis confronté à un nouveau problème et malgré mes recherches sur le forum XLD je n'ai rien trouvé... Et étant encore débutant en VB je bloque.

Mon problème est en fait toujours une comparaison/extraction, mais cette fois ce que je veux extraire sont les données manquantes.

Je m'explique : dans l'exemple ci-joint, je cherche à comparer les colonnes B de Feuil2 et A de Feuil1. Le but serait d'extraire les références de la colonne B non présentes dans la colonne A, et d'insérer ces références dans Feuil3 (colonne A par exemple). De plus, je souhaiterai intégrer cette procédure dans une macro en VB déjà existante, il me faudrait donc une solution en VB.

Quelqu'un a-t-il une idée ?

Merci d'avance,

Tibogn
 

Pièces jointes

  • Exemple.xls
    23 KB · Affichages: 64
  • Exemple.xls
    23 KB · Affichages: 66
  • Exemple.xls
    23 KB · Affichages: 75

Davidc57

XLDnaute Occasionnel
Re : Comparaison + Extraction ép. 2

Bonjour le forum, bonjour tibogn,

Essaye ceci :

Code:
Sub test()

ndl1 = Sheets("Feuil1").Range("A65536").End(xlUp).Row
ndl2 = Sheets("Feuil2").Range("B65536").End(xlUp).Row
compteur = 2

For i = 2 To ndl2
    trouve = False
    For j = 2 To ndl1
        If Sheets("Feuil2").Range("B" & i) = Sheets("Feuil1").Range("A" & j) Then
            trouve = True
            GoTo Suivant
        End If
    Next j
    Sheets("Feuil3").Range("A" & compteur) = Sheets("Feuil2").Range("B" & i)
    compteur = compteur + 1
Suivant:
Next i


End Sub

A+
David
 

Efgé

XLDnaute Barbatruc
Re : Comparaison + Extraction ép. 2

Bonjour Tibogn, Davidc57,
Il existe un code de J.Boisgontier (que j'ai adapté à vos colonnes et feuilles).
Code:
Private Sub CommandButton1_Click()
  Set f1 = Sheets("Feuil2")
  Set f2 = Sheets("Feuil1")
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In f2.Range("a2:a" & f2.[a65000].End(xlUp).Row)
    MonDico1.Item(c.Value) = c.Value
  Next c
  Set MonDico2 = CreateObject("Scripting.Dictionary")
  For Each c In f1.Range("b2:b" & f1.[b65000].End(xlUp).Row)
   If Not MonDico1.exists(c.Value) Then If Not MonDico2.exists(c.Value) Then MonDico2.Add c.Value, c.Value 
  Next c
  Sheets("Feuil3").[A2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.keys)
End Sub
Cordialement
 

Pièces jointes

  • Exemple(2).zip
    11.9 KB · Affichages: 36
  • Exemple(2).zip
    11.9 KB · Affichages: 45
  • Exemple(2).zip
    11.9 KB · Affichages: 40

Tibogn

XLDnaute Nouveau
Re : Comparaison + Extraction ép. 2

Bonjour Efgé et Davidc57 et les autres !

Merci de votre participation, vos deux codes marchent sans problème !
En terme de temps d'exécution, j'avoue ne pas avoir vu de grandes différences, vu que pour les données de l'exemple, le temps est très court.
J'aurais probablement à utiliser la même procédure avec de plus grandes plages de données, je vous dirais si une des méthodes est plus rapide en termes de temps d'exe.

Merci encore de votre aide précieuse !

Tibogn
 

Discussions similaires

Réponses
8
Affichages
460
Réponses
31
Affichages
742
Réponses
3
Affichages
461

Statistiques des forums

Discussions
312 789
Messages
2 092 125
Membres
105 226
dernier inscrit
Pepecham