Classement auto d'une liste brute

[Adrien39]

Bonjour,

Besoin d'aide pour réaliser une macro qui classe les informations d'une liste brut!
Voir fichier joint !

Merci d'avance pour votre aide !

 

[phlaurent55]

Bonjour Adrien,

voir fichier joint

à+
Philippe

 

[Adrien39]

Merci beaucoup 🙂

 

[Adrien39]

Petite question, pourquoi i=4 et j=4 ?

A quoi correspond le 4?
Merci 🙂

 

[Adrien39]

Bonjour Philippe,

N'arrivant pas à appliquer votre code sur mon fichier original, je vous mets ci-joint le vrai fichier.
Les emplacements de colonne sont différents, je pense que je bloque la dessus au niveau du code.

Merci pour votre aide.

 

[Paf]

Bonjour Adrien39, phlaurent55,

le classeur réel est bien différent du classeur exemple !

Il s'agit de classer 13 sous produits ( E, I, J, K.....) dans 10 colonnes nommées Sous produits 1 à Sous produits 10.

dans quelles colonnes vont les produit de la feuille 2 et notamment les 3 produit en trop ?

A+

 

[Adrien39]

Bonjour !

J'ai vu en effet que ce n'était pas si simple.
Je vous mets un fichier ci-joint avec les résultats que j'attends.
Le nombre de produits et sous produits est aléatoire.

En fait, j'ai un fichier brut ( non exploitable pour moi, onglet " niveau").
Je souhaite pouvoir faire un classement des résultats de ce fichier brut dans l'onglet "feuil1"

J'espère être plus clair :s

 

[Paf]

Re,

une macro à tester:

Sub GroupLigne()
Dim W1 As Worksheet, W2 As Worksheet, Prod As String, SsProd As String, i As Integer, j As Integer
Dim dico, T, TT(1 To 11), TT2
Set dico = CreateObject("Scripting.Dictionary")
Set W1 = Worksheets("Feuil1")
Set W2 = Worksheets("Niveau")
W1.Range("H3:Q11").ClearContents
T = W2.Range("A2:G" & W2.Range("A" & Rows.Count).End(xlUp).Row)
For i = LBound(T, 1) To UBound(T, 1)
    If Not dico.exists(T(i, 1)) Then
        TT(1) = T(i, 7)
        TT(11) = 1
        dico(T(i, 1)) = TT
    Else
        TT2 = dico(T(i, 1))
        ind = TT2(11)
        TT2(11) = ind + 1
        TT2(ind + 1) = T(i, 7)
        dico(T(i, 1)) = TT2
    End If
    Erase TT
Next i

W1.Range("H3").Resize(dico.Count, UBound(TT) - 1) = Application.Transpose(Application.Transpose(dico.items))
End Sub

A+