Création matrice

Bonjour à tous,

LA question a peut-être déjà été posée, mais je ne retrouve rien dans le forum qui corresponde.

JE voudrais créer une matrice au départ d'un fichier qui comporte trois colonnes de donnés, la colonne A fait référence à un n° de lot qui se répétera en fonction du nombre de critères de la conne B et la colonne C donne le résultat correspondant au critère de la colonne B.

Dans le fichier joint vous trouvez les trois colonnes en question et en zone E1:J4, la matrice que je voudrais obtenir, cette matrice devrait se créer dans une nouvelle feuille du classeur.

J'espère avoir était assez clair dans al requête.

D'avance merci pour votre aide,

Robert

Bonjour,

Un essai à tester

Bonjour,

Ah, M12 a été plus rapide que moi

Comme je suis parti du principe que la liste n'était pas forcément triée ni complète je poste quand même :

Sub mat()
    Dim datas, mat(), dictLot, dictArg
    Dim nblig As Long, lig As Long, j As Long
    Set dictLot = CreateObject("Scripting.Dictionary")
    Set dictArg = CreateObject("Scripting.Dictionary")

    nblig = Cells(Rows.Count, 1).End(xlUp).Row - 1
    datas = [A2].Resize(nblig, 3)
    ReDim mat(1 To [nbLot], 1 To [nbArg])
    For lig = 1 To UBound(datas, 1)
        If Not dictLot.exists(datas(lig, 1)) Then dictLot(datas(lig, 1)) = dictLot.Count + 1
        If Not dictArg.exists(datas(lig, 2)) Then dictArg(datas(lig, 2)) = dictArg.Count + 1
        mat(dictLot(datas(lig, 1)), dictArg(datas(lig, 2))) = datas(lig, 3)
    Next lig
    With Sheets("Feuil2")
        .Cells.ClearContents
        .[A2].Resize(dictLot.Count) = Application.Transpose(dictLot.keys)
        .[B1].Resize(, dictArg.Count) = dictArg.keys
        .[B2].Resize(UBound(mat, 1), UBound(mat, 2)) = mat
        .Select
    End With
    Set dictLot = Nothing
    Set dictArg = Nothing
End Sub

2 noms à définir dans le classeur.

eric

eriiic a écrit :

Bonjour,

Ah, M12 a été plus rapide que moi

Comme je suis parti du principe que la liste n'était pas forcément triée ni complète je poste quand même :

Sub mat()
    Dim datas, mat(), dictLot, dictArg
    Dim nblig As Long, lig As Long, j As Long
    Set dictLot = CreateObject("Scripting.Dictionary")
    Set dictArg = CreateObject("Scripting.Dictionary")

    nblig = Cells(Rows.Count, 1).End(xlUp).Row - 1
    datas = [A2].Resize(nblig, 3)
    ReDim mat(1 To [nbLot], 1 To [nbArg])
    For lig = 1 To UBound(datas, 1)
        If Not dictLot.exists(datas(lig, 1)) Then dictLot(datas(lig, 1)) = dictLot.Count + 1
        If Not dictArg.exists(datas(lig, 2)) Then dictArg(datas(lig, 2)) = dictArg.Count + 1
        mat(dictLot(datas(lig, 1)), dictArg(datas(lig, 2))) = datas(lig, 3)
    Next lig
    With Sheets("Feuil2")
        .Cells.ClearContents
        .[A2].Resize(dictLot.Count) = Application.Transpose(dictLot.keys)
        .[B1].Resize(, dictArg.Count) = dictArg.keys
        .[B2].Resize(UBound(mat, 1), UBound(mat, 2)) = mat
        .Select
    End With
    Set dictLot = Nothing
    Set dictArg = Nothing
End Sub

2 noms à définir dans le classeur.

eric

Bonjour à tous,

Merci à Eriiic et M12 pour vos réponses, j'ai du "bidouiller" un peu mon fichier source, mais votre macro fonctionne parfaitement.

Ce fût ma première requête sur ce forum et je suis très satisfait du résultat.

A bientôt,

robert