Recherche selon plusieurs valeurs

xamenod

XLDnaute Junior
Bonjour, j'ai dans le fichier ci-joint, deux colonnes A et B, dans A une liste de valeurs en doublons. Dans B une liste de valeurs uniques. Le but de la manœuvre est de récupérer en vis à vis de la colonne D, les valeurs de la colonne B. Pas très clair tout ça... J'ai essayé avec des rechercheV, des combinaisons de formules, je n'ai pas réussi... le fichier a plusieurs milliers de lignes. C'est plus facile à comprendre dans le fichier joint... Merci pour votre aide et bon weekend. Henry.
 

Pièces jointes

  • TEST_1.xlsx
    71.6 KB · Affichages: 29

BOISGONTIER

XLDnaute Barbatruc
Bonjour,


Faut-il que les indices soient en ordre croissant?
Si c'est le cas, il faut trier la BD par GA/Code.

S'il n'y a pas de doublons dans les indices

Code:
Sub Regroupe()
  Set f = Sheets("feuil1")
  Set d = CreateObject("Scripting.Dictionary")
  Tbl = f.Range("A2:B" & f.[a65000].End(xlUp).Row).Value
  For i = LBound(Tbl) To UBound(Tbl)
   d(Tbl(i, 1)) = d(Tbl(i, 1)) & Tbl(i, 2) & "|"
  Next i
  Set f2 = Sheets("feuil2")
  f2.[A2].Resize(d.Count) = Application.Transpose(d.keys)
  f2.[B2].Resize(d.Count) = Application.Transpose(d.items)
  Application.DisplayAlerts = False
  f2.Range("B2").Resize(d.Count).TextToColumns Other:=True, OtherChar:="|"
  Cells.EntireRow.AutoFit
End Sub

S'il y a des doublons dans les indices d'un code:

Code:
Sub RegroupeUniquesCode()  ' si doublons dans les indices
  Set f = Sheets("feuil1")
  Set d = CreateObject("Scripting.Dictionary")
  Set d1 = CreateObject("Scripting.Dictionary")
  Tbl = f.Range("A2:B" & f.[a65000].End(xlUp).Row).Value
  For i = LBound(Tbl) To UBound(Tbl)    ' élimination doublons pour un code
   If Tbl(i, 2) <> "" Then d1(Tbl(i, 1) & "|" & Tbl(i, 2)) = ""
  Next i
  For Each c In d1.keys     ' regroupement par code
    a = Split(c, "|")
    d(a(0)) = d(a(0)) & a(1) & "|"
  Next c
  Set f2 = Sheets("feuil2")
  n = d.Count
  Dim TblRes: ReDim TblRes(1 To d.Count, 1 To 2)
  i = 0
  For Each c In d.keys
     i = i + 1
     TblRes(i, 1) = c: TblRes(i, 2) = d(c)
  Next c
  f2.[A2].Resize(d.Count, 2) = TblRes
  Application.DisplayAlerts = False
  f2.[B2].Resize(d.Count).TextToColumns Other:=True, OtherChar:="|"
  f2.Cells.EntireRow.AutoFit
End Sub

Boisgontier
 

Pièces jointes

  • Copie de TEST_1.xlsm
    120.3 KB · Affichages: 25
Dernière édition:

xamenod

XLDnaute Junior
Bonjour,


Faut-il que les indices soient en ordre croissant?
Si c'est le cas, il faut trier la BD par GA/Code.

S'il n'y a pas de doublons dans les indices

Code:
Sub Regroupe()
  Set f = Sheets("feuil1")
  Set d = CreateObject("Scripting.Dictionary")
  Tbl = f.Range("A2:B" & f.[a65000].End(xlUp).Row).Value
  For i = LBound(Tbl) To UBound(Tbl)
   d(Tbl(i, 1)) = d(Tbl(i, 1)) & Tbl(i, 2) & "|"
  Next i
  Set f2 = Sheets("feuil2")
  f2.[A2].Resize(d.Count) = Application.Transpose(d.keys)
  f2.[B2].Resize(d.Count) = Application.Transpose(d.items)
  Application.DisplayAlerts = False
  f2.Range("B2").Resize(d.Count).TextToColumns Other:=True, OtherChar:="|"
  Cells.EntireRow.AutoFit
End Sub


Boisgontier



Bonsoir, merci de vous pencher sur ce problème. c'est certes un confort, mais il n'est pas obligatoire que les indices soient en ordre croissant. JE viens de tester cela fonctionne parfaitement. Merci pour votre aide.
 

Discussions similaires