XL 2010 Trouver le mot qui manque dans une liste

[anthonygg]

Bonjour,

J'ai crée un petit logiciel qui compare deux listes de prénoms. Je clique sur le bouton ''Trouve le nom manquant'', puis je selectionne la première liste puis la seconde, ensuite le logiciel trouve le nom manquant.

Ce que j'aimerai faire c'est simplifier la saisie pour ne pas avoir a tout selectionner et à scroller, par exemple juste cliquer sur la date et que cela selectionne automatiquement la liste de prénoms qui est en dessous.

Par exemple si je saisie la date en A2 que ça me selectionne de A5:A6000. Et si je selectionne B2 que ça me selectionne B5:B6000

Merci, je pense que c'est facile mais pas pour moi

 

[Robert]

Bonsoir Anthony, bonsoir le forum,

Une remarque. Ton code devrait plutôt se trouver dans un module standard...
Je l'ai modifié pour que l'utilisateur n'ait plus qu'à cliquer sur n'importe quelle cellule de la colonne pour la définir. Tu adapteras le message...
Le code :

Sub plager()
Dim O As Worksheet
Dim reponseA As Variant
Dim COL As Byte
Dim reponseB As Variant
Dim PlageA As Range, PlageB As Range, c As Range, Ligne As Long

Set O = Sheets("BDD")
O.Activate
O.Range("I1").CurrentRegion.Offset(0, 1).ClearContents
On Error Resume Next
Set reponseA = Application.InputBox(Prompt:="Veuillez sélectionner n'importe quelle cellule de la première colonne.", Type:=8)
If reponseA Is Nothing Then Exit Sub
COL = reponseA.Column
Set PlageA = O.Range(O.Cells(5, COL), O.Cells(Application.Rows.Count, COL).End(xlUp))
Set reponseB = Application.InputBox(Prompt:="Veuillez sélectionner n'importe quelle cellule de la seconde colonne.", Type:=8)
If reponseB Is Nothing Then Exit Sub
COL = reponseB.Column
Set PlageB = O.Range(O.Cells(5, COL), O.Cells(Application.Rows.Count, COL).End(xlUp))
Ligne = 1
For Each c In PlageA
    If WorksheetFunction.CountIf(PlageB, c.Value) = 0 Then
    Range("J" & Ligne).Value = c.Value
    Ligne = Ligne + 1
    End If
Next c
Sheets("ListeCopierColler").Activate
End Sub

 

[job75]

Bonjour anthonygg, Robert,

Sur une grande plage calculer CountIf (NB.SI) sur toutes les cellules prend trop de temps.

Avec des objets Dictionary c'est très rapide, voyez le fichier joint et ces macros :

Sub CreerListes()
With Feuil2.[A5:B6000] 'plage de 2 colonnes, à adapter
  .Formula = "=TEXT(RANDBETWEEN(1,1200),""P0000"")" 'ALEA.ENTRE.BORNES
  .Value = .Value 'supprime les formules
  Call Comparer(.Cells, Feuil2.[E5]) 'cellule de restitution à adapter
End With
End Sub

Sub Comparer(plage As Range, restit As Range)
Dim d1 As Object, d2 As Object, t, i&, a, manque(), m&, plus(), p&
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare 'la casse est ignorée
'---listes sans doublons---
t = plage.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(t): d1(t(i, 1)) = "": Next
For i = 1 To UBound(t): d2(t(i, 2)) = "": Next
'---manque---
If d1.Count Then
  a = d1.keys
  ReDim manque(1 To d1.Count, 1 To 1)
  For i = 0 To UBound(a)
    If Not d2.exists(a(i)) Then m = m + 1: manque(m, 1) = a(i)
  Next
End If
'---plus---
If d2.Count Then
  a = d2.keys
  ReDim plus(1 To d2.Count, 1 To 1)
  For i = 0 To UBound(a)
    If Not d1.exists(a(i)) Then p = p + 1: plus(p, 1) = a(i)
  Next
End If
'---restitution sur restit et tris---
Application.ScreenUpdating = False
restit.Resize(Rows.Count - restit.Row + 1, 2) = "" 'RAZ
If m Then restit.Resize(m) = manque: restit.Resize(m).Sort restit
If p Then restit(1, 2).Resize(p) = plus: restit(1, 2).Resize(p).Sort restit(1, 2)
Set restit = Cells.Find(restit, , xlValues, , xlByColumns) 'initialise la boîte de dialogue Rechercher
End Sub

A+

 

[anthonygg]

Merci Robert j'ai retenu ta solution ! Super ça marche au poil.
Merci à job aussi !