Recherche selon plusieurs valeurs

[xamenod]

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.

 

[BOISGONTIER]

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

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:

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

 

[JHA]

Bonjour à tous,

avec petite.valeur()

=SIERREUR(PETITE.VALEUR(SI($A$2:$A$3728=$D2;$B$2:$B$3728);COLONNE(A:A));"")

JHA

 

[djidji59430]

Bonjour,

en formule

(le meme, un instant plus tard !)

 

[xamenod]

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

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.

 

[xamenod]

Bonjour,

en formule

(le meme, un instant plus tard !)

Merci, à tous, vos solutions fonctionnent. C'est ici que l'on voit la richesse et la complexité d'un tel logiciel, un problème plusieurs voies différentes. Merci pour votre investissement, je vous souhaite un très bon weekend. Henry.

 

[BOISGONTIER]

Il y a des indices doublons. Il faut prendre le 2e code.
Les formules proposées ne gèrent pas les indices doublons (cf GA 81 e.g.).

Boisgontier