Transposé automatiquement

Bonjour à tous,

Je sollicite votre aide car je n'arrive pas à résoudre mon problème automatiquement

En effet, j'aimerais avoir la colonne en ligne par nom

Par exemple, sur mon fichier je voudrais pour ADV, les valeurs des lignes correspondantes dans C en colonne

De même, pour CHINA_DEMO et CRM_PIERRON

Et ensuite supprimer les valeurs doublons

Voir le fichier joint avec un petit exemple et le résultat attendu (le fichier d'origine contient 4000 lignes^^)

Merci d'avance pour votre aide

Bonsoir,

Au départ, il y a toujours 3 colonnes ?

Claude

Salut le forum

J'espère qu'il a Excel 2007 et + car le fichier d'origine contient 4000 lignes.

benji41

Nouveau venu

Messages: 1

Inscription: 27 Déc 2011, 10:48

Version Excel: 2003

Mytå

Bonjour,

Par un code macro, si cela ne te dérange pas.

Regarde le fichier joint, et clique sur le bouton jaune.

Pour ce faire, j'ai rajouté un onglet nommé "result"

Et je suis parti sur ces hypothèses :

- Tu as fait une erreur dans ton onglet "Resultat attendu" (regarde dans le fichier)

- Les valeurs de la colonne B sont identiques à la colonne A (par exemple, pour "ADV", ce sera toujours "ADV Bostik ADV")

- Tu n'as que trois colonnes (A, B et C)

- Tu travailles bien sur Excel 2003, donc tu ne peux avoir plus de 254 lignes concernant une même valeur de la colonne A

Si une de mes hypothèses est fausse, bien vouloir remettre un fichier exemple au plus près de la réalité

Pour info, pour 6000 lignes, durée du traitement : 0.14 s

Le code :

Sub transpose_donnees()
Dim Cel As Range
Dim Usine As Object, LeNom As Object
Dim FDonnee As Worksheet, FResult As Worksheet
Dim Lig As Long, Nbr As Long, DerLig As Long
Dim It
t = Timer
Set FDonnee = Sheets("Exemple")
Set FResult = Sheets("result")
Set Usine = CreateObject("Scripting.Dictionary")
Set LeNom = CreateObject("Scripting.Dictionary")
FResult.Range("A2:IV4000").Clear
FDonnee.Range("A1:C" & FDonnee.Cells(Rows.Count, "A").End(xlUp).Row).Sort _
    Key1:=FDonnee.Range("A2"), Order1:=xlAscending, _
    Key2:=FDonnee.Range("B2"), Order2:=xlAscending, _
    Key3:=FDonnee.Range("C2"), Order3:=xlAscending, Header:=xlYes
For Each Cel In FDonnee.Range("A2:A" & FDonnee.Cells(Rows.Count, "A").End(xlUp).Row)
    Usine(Cel.Value) = Cel.Value
Next Cel
For Each It In Usine.Items
    Lig = Application.Match(It, FDonnee.Columns(1), 0)
    Nbr = Application.CountIf(FDonnee.Columns(1), It)
    LeNom(Cells(Lig, 2).Value) = Cells(Lig, 2).Value
    For Each Cel In Cells(Lig, 3).Resize(Nbr)
        LeNom(Cel.Value) = Cel.Value
    Next Cel
    With FResult
        DerLig = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(DerLig, 1).Value = It
        .Cells(DerLig, 2).Resize(1, LeNom.Count) = LeNom.Items
    End With
    LeNom.RemoveAll
Next It
FResult.Cells.Columns.AutoFit
MsgBox Timer - t
End Sub

Le fichier :

PS, Salut Claude et Mytå, je me suis posé les mêmes questions....

Bonne soirée

Oui y'avait une colonne doublon en trop désolé

Super merci bien !

Tout à fait cela qu'il me fallait

Merci encore !