Retrouver des lignes d'une feuille sur une autre feuille

[ram9z]

Bonjour,

J'ai une question à vous poser, comment faire pour retrouver dans le cas d'une base de données de prospects la présence ou non de lignes dans une feuille excel ? J'ai 250 lignes, donc c'est assez long a vérifier manuellement. Merci d'avance

 

[Dranreb]

Bonjour.
Il y a plusieurs solutions, ça dépend du contexte.
La 1ère qui me vient à l'esprit c'est une formule =EQUIV(Quoi;Où;0) qui renvoie le numéro de ligne dans Où où se trouve Quoi et #N/A s'il ne s'y trouve pas.

 

[ram9z]

En faite, j'ai 3 bases de données dans un classeur excel, dont une base de données GLOBALE (2000 lignes), une base de données prioritaire (200 lignes)et une base de données de refus (50 lignes). Je dois verifier si le contenu de la base de données prioritaire et de refus se retrouve bien dans la base de données globale (tout en sachant que j'ai plusieurs colonnes : contact, numero de tel...)

 

[Dranreb]

Et bien moi je ne les ai pas…

 

[job75]

Bonjour ram9z, Bernard,

Voici une solution VBA qui permet de comparer les lignes de 3 tableaux :

Sub ComparerLignes()
Dim deb1 As Range, deb2 As Range, deb3 As Range, ncol%, derlig&, t, d As Object, i&, x$, j%
'---définitions à adapter---
Set deb1 = Sheets("GLOBALE").[A1] '1ère cellule du 1er tableau
Set deb2 = Sheets("Prioritaire").[A1] '1ère cellule du 2ème tableau
Set deb3 = Sheets("Refus").[A1] '1ère cellule du 3ème tableau
ncol = 10 'nombre de colonnes de chacun des tableaux
'---étude des lignes du 1er tableau---
If deb1 = "" Then deb1 = " " 'au moins une cellule non vide
derlig = deb1.Resize(Rows.Count - deb1.Row + 1, ncol).Find("*", , xlValues, , xlByRows, xlPrevious).Row
t = deb1.Resize(derlig - deb1.Row + 1, ncol) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(t)
  x = ""
  For j = 1 To ncol
    x = x & Chr(1) & t(i, j)
  Next
  d(x) = ""
Next
'---étude des lignes du 2ème tableau---
deb2(1, ncol + 1).EntireColumn = "" 'RAZ
If deb2 = "" Then deb2 = " " 'au moins une cellule non vide
derlig = deb2.Resize(Rows.Count - deb2.Row + 1, ncol).Find("*", , xlValues, , xlByRows, xlPrevious).Row
t = deb2.Resize(derlig - deb2.Row + 1, ncol) 'matrice, plus rapide
For i = 1 To UBound(t)
  x = ""
  For j = 1 To ncol
    x = x & Chr(1) & t(i, j)
  Next
  If Not d.exists(x) Then deb2(i, ncol + 1) = "Pas dans GLOBALE"
Next
'---étude des lignes du 3ème tableau---
deb3(1, ncol + 1).EntireColumn = "" 'RAZ
If deb3 = "" Then deb3 = " " 'au moins une cellule non vide
derlig = deb3.Resize(Rows.Count - deb3.Row + 1, ncol).Find("*", , xlValues, , xlByRows, xlPrevious).Row
t = deb3.Resize(derlig - deb3.Row + 1, ncol) 'matrice, plus rapide
For i = 1 To UBound(t)
  x = ""
  For j = 1 To ncol
    x = x & Chr(1) & t(i, j)
  Next
  If Not d.exists(x) Then deb3(i, ncol + 1) = "Pas dans GLOBALE"
Next
End Sub

Allez dans VBA (Alt+F11) et collez la macro où vous voulez, puis exécutez-la (Alt+F8).

A+

 

[ram9z]

Bonsoir Bernard et merci, j'ai collé cette formule sur la feuille 1 mais j'obtient l'erreur 9 : l'indice n'appartient pas à la selection

 

[job75]

Re,

La macro n'est pas de Bernard cher ami

Quant au message d'erreur vous n'avez pas dû mettre en début de macro les bons noms des 3 feuilles.

Attention aux espaces superflus à la fin des noms des onglets, c'est une erreur fréquente...

A+

 

[job75]

Bonjour à tous,

ram9z semble avoir disparu mais je continue avec un code plus ramassé et une macro paramétrée :

Sub ComparerLignes()
Dim ncol%, d As Object
ncol = 10 'nombre de colonnes de chacun des tableaux, à adapter
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Tableau Sheets("GLOBALE").[A1], ncol, d, True '1er tableau, 1ère cellule à adapter
Tableau Sheets("Prioritaire").[A1], ncol, d, False '2ème tableau, 1ère cellule à adapter
Tableau Sheets("Refus").[A1], ncol, d, False '3ème tableau, 1ère cellule à adapter
End Sub

Sub Tableau(deb As Range, ncol%, d As Object, globale As Boolean)
Dim derlig&, t, i&, x$, j%
deb(1, ncol + 1).EntireColumn = "" 'RAZ
If deb = "" Then deb = " " 'au moins une cellule non vide
derlig = deb.Resize(deb.Parent.Rows.Count - deb.Row + 1, ncol).Find("*", , xlValues, , xlByRows, xlPrevious).Row
t = deb.Resize(derlig - deb.Row + 1, ncol) 'matrice, plus rapide
For i = 1 To UBound(t)
  x = ""
  For j = 1 To ncol
    x = x & Chr(1) & t(i, j)
  Next
  If globale Then d(x) = "" Else If Not d.exists(x) Then deb(i, ncol + 1) = "Pas dans GLOBALE"
Next
End Sub

A+