Extraire avec classement

[Florian53]

Bonjour à tous,

Je souhaiterais en vba extraire une liste de famille ("D250") par rapport à son rang (("C2:C50"), j'aimerais que ces familles ce colle en mode transpose sur la ligne de la feuil("Données").

J'ai essayé d’adapter un code mais sa ne fonctionne pas :

Sub Family()
'Déclaration des variables.
Dim arrBDD()
Dim shBDD As Worksheet, shDonn As Worksheet
Dim dico As Object
Dim i&
Dim valeurcherche

j = 0

'Enregistrement des objets.
Set shBDD = ThisWorkbook.Sheets("Feuil2")
Set shDonn = ThisWorkbook.Sheets("Données")
Set dico = CreateObject("Scripting.Dictionary")

For j = 0 To 50
'Enregistrement du tableau arrBDD.
With shBDD
    i = .Cells.Find("1" + j, , , , xlByRows, xlPrevious).Row
    arrBDD = .Range(.Cells(2, "C"), .Cells(i, "D")).Value
End With

'Enregistrement des critères.
With shBDD
    valeurcherche = j + 1
End With

'Boucle du tableau virtuel.
For i = LBound(arrBDD) + 1 To UBound(arrBDD)

    If arrBDD(i, 1) = valeurcherche Then
        dico(arrBDD(i, 2)) = dico(arrBDD(i, 2))
    End If
   
Next i
Next j

'Report des sommes dans la feuille Données.
With shDonn
    i = 4
    Do While .Cells(2, i).Value <> ""
        .Cells(2, 4).Offset(, 1).Value = dico(.Cells(2, "4").Value)
        i = i + 1
    Loop
End With
End Sub

Pouvez vous m'aider svp?

 

[thebenoit59]

Bonjour Florian.

Le code que je t'avais fourni ne correspond pas du tout à cette problématique...

Option Explicit

Sub Family()
'Déclaration des variables.
Dim arrBDD()
Dim shBDD As Worksheet, shDonn As Worksheet
Dim dico As Object
Dim i&

'Enregistrement des objets.
Set shBDD = ThisWorkbook.Sheets("Feuil2")
Set shDonn = ThisWorkbook.Sheets("Données")
Set dico = CreateObject("Scripting.Dictionary")

'Enregistrement du tableau arrBDD.
With shBDD
    i = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    arrBDD = .Range(.Cells(2, "C"), .Cells(i, "D")).Value
End With

'Boucle du tableau virtuel.
For i = LBound(arrBDD) + 1 To UBound(arrBDD)
    dico(arrBDD(i, 1)) = arrBDD(i, 2)
Next i

'Report des sommes dans la feuille Données.
With shDonn
    For i = 1 To dico.Count
        .Cells(2, i + 3).Value = dico(CDbl(i))
    Next i
End With
End Sub

Ca devrait fonctionner.

 

[Florian53]

Merci thebenoit59, sa fonctionne trop bien tu es vraiment très fort