XL 2016 Réorganisation tableau de données

[SeXMaN]

Bonjour,

Dans mon tableau j'ai des doublons, j'aimerai supprimer les doublons mais grader les informations.
J'ai mis un exemple dans le fichier.
J'avais penser donner un code à partir des nom et prénoms des personnes mais cela ne fonctionne pas.
Auriez vous une idée ? sans VBA si possible.

Merci d'avance.

 

[R@chid]

Bonjour,
En I3 :

=SIERREUR(DECALER(A$2;EQUIV(0;NB.SI(I$2:I2;A$3:A$17);0););"")

@ valider par Ctrl+Maj+Enntrée et à tirer vers le bas

En J3:

=SIERREUR(DECALER($A$2;PETITE.VALEUR(SI($A$3:$A$17=$I3;LIGNE(INDIRECT("1:"&LIGNES($A$3:$A$17))));ENT((COLONNES($J:J)-1)/3)+1);MOD(COLONNES($J:J)-1;3)+1);"")

@ valider par Ctrl+Maj+Enntrée et à tirer vers le bas et vers la droite


Voir PJ


Cordialement

 

[R@chid]

Re,
Si la base de données et bien triées de façons à ce que les doublons ne se séparent pas le cas de IVAN et LENA, on peut faire une formule classique en J3:

=SI(NB.SI($A$3:$A$17;$I3)<ENT((COLONNES($J:J)-1)/3)+1;"";DECALER($A$2;EQUIV($I3;$A$3:$A$17;0)+ENT((COLONNES($J:J)-1)/3);MOD(COLONNES($J:J)-1;3)+1))

@ tirer vers le bas et vers la droite


Cordialement

 

[sylvanu]

Bonjour SexMan, R@chid,
Un essai en PJ avec un peu de VBA.
La liste se reconstruit en automatique lorsqu'on sélectionne la feuille Liste avec :

Sub Worksheet_Activate()
Application.ScreenUpdating = False
DL = Sheets("Données brutes").Range("A65500").End(xlUp).Row
tablo = Sheets("Données brutes").Range("A3:D" & DL) ' Tranfert dans array
With Sheets("Liste")
    .Range("A2:Z1000").ClearContents ' Effacement matrice
    For L = 1 To UBound(tablo)
        Prénom = tablo(L, 1)    ' extraction prénom en cours
        If Application.CountIf(.Range("A:A"), Prénom) = 0 Then  ' on regarde s'il existe
            ' première apparition du prénom
            DL2 = .Range("A65500").End(xlUp).Row + 1            ' calcul première ligne vide
            .Cells(DL2, "A") = tablo(L, 1): .Cells(DL2, "B") = tablo(L, 2) ' On range les quatre données
            .Cells(DL2, "C") = tablo(L, 3): .Cells(DL2, "D") = tablo(L, 4)
        Else
            ' le prénom est déjà présent
            Ligne = Application.Match(Prénom, .Range("A:A"), 0)             ' Ligne où prénom existe
            Colonne = .Cells(Ligne, .Columns.Count).End(xlToLeft).Column    ' Première cellule vide
            .Cells(Ligne, Colonne + 1) = tablo(L, 2)                        ' On range les trois données
            .Cells(Ligne, Colonne + 2) = tablo(L, 3)
            .Cells(Ligne, Colonne + 3) = tablo(L, 4)
        End If
    Next L
End With
End Sub

 

[SeXMaN]

Merci pour vos aides que je vais mettre en pratique. Merci.