Transformation de tableau

Bonjour à tous,

Désolé pour le titre du thread, je n'arrive pas à synthétiser l'idée en quelques mots.

Dans excel 2007, je tente de transformer un tableau.

Le tableau d'origine (à gauche) est généré par un logiciel, mais il n'est pas lisible sous cette forme. Chaque élément possède des dizaines de propriétés (les mêmes pour tous les éléments).

Afin de simplifier la lecture du tableau, j'ai besoin de changer son format.

Les valeurs peuvent être numériques ou textuelles.

J'ai tenté d'utiliser des tableaux croisés dynamiques, sans résultat. J'arrive bien à mettre mon tableau en forme, mais des formules sont systématiquement appliquées sur mes valeurs, ce que je ne veux pas.

Existe-il un moyen plus simple pour réaliser cette transposition?

Je n'ai actuellement "que" 420 lignes à transposer, mais j'en aurais bientôt plusieurs milliers, je souhaite trouver une méthode qui puisse supporter cette montée en volume.

Merci d'avance

Bonjour Guigou, le forum

Vois ceci :

Option Explicit

Sub Ventile()
Dim a, i As Long, j As Long, AL As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    a = Sheets("Feuil1").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not AL.Contains(a(i, 1)) Then AL.Add a(i, 1)
            If Not .exists(a(i, 2)) Then
                Set .Item(a(i, 2)) = _
                CreateObject("Scripting.Dictionary")
                .Item(a(i, 2)).CompareMode = 1
            End If
            .Item(a(i, 2))(a(i, 1)) = a(i, 3)
        Next
        AL.Sort
        ReDim a(1 To .Count + 1, 1 To AL.Count + 1)
        a(1, 1) = ""
        For i = 0 To AL.Count - 1
            a(1, i + 2) = AL(i)
        Next
        For i = 0 To .Count - 1
            a(i + 2, 1) = .keys()(i)
            For j = 0 To .items()(i).Count - 1
                a(i + 2, AL.IndexOf(.items()(i).keys()(j), 0) + 2) = .items()(i).items()(j)
            Next
        Next
    End With
    With Sheets("Feuil2").Cells(1).Resize(UBound(a, 1), UBound(a, 2))
        .CurrentRegion.ClearContents
        .Value = a
        .Parent.Select
    End With
End Sub

klin89

Salut Klin89, merci pour ta réponse.

Je pars de loin en Excel/VBA, j'ai intégré ce code dans ma feuil1 mais à l'exécution j'obtiens une erreur 9 : "L'indice n'appartient pas à la sélection".

La ligne en problème est "a = Sheets("Feuil1").Cells(1).CurrentRegion.Value"

Je m'y prends sans doute mal

Bonjour,

Tes données doivent commencer en A1.

Cdlt.

Bonjour,

Voir PJ

Sub Stat2DBis()
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  Dim a(1 To 100, 1 To 100)
  lig = 1
  col = 1
  Mlig = lig
  Mcol = col
  For Each c In Range("a2:a" & [A65000].End(xlUp).Row)
    If d1.exists(c.Value) Then lig = d1(c.Value) Else d1(c.Value) = Mlig: lig = Mlig: Mlig = Mlig + 1
    tmp = c.Offset(, 1)
    If d2.exists(tmp) Then col = d2(tmp) Else d2(tmp) = Mcol: col = Mcol: Mcol = Mcol + 1
    a(lig, col) = c.Offset(, 2)
  Next c
  [m2].Resize(d2.Count, 1) = Application.Transpose(d2.keys)
  [n1].Resize(1, d1.Count) = d1.keys
  [n2].Resize(d2.Count, d1.Count) = Application.Transpose(a)
End Sub

Ceuzin

24stat2d.zip (12.87 Ko)

Merci Jean-Eric, effectivement ça fonctionne mieux sans titre de colonne

Merci ceuzin, je vais aussi essayer ton code.

Ayant trouvé ici des gens si sympathiques, je risque de revenir souvent

Re le forum,

Une autre façon de procéder en évitant Application.Transpose

Les données en Feuil1, à partir de A1.

On garde les en-têtes

Restitution à côté du tableau original.

Sub Ventile2()
Dim a, b, i As Long, n As Long, t As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1))
        n = 1: t = 1
        With CreateObject("Scripting.Dictionary")
            For i = 2 To UBound(a, 1)
                If Not dico.exists(a(i, 2)) Then
                    n = n + 1: dico(a(i, 2)) = n
                    b(n, 1) = a(i, 2)
                End If
                If Not .exists(a(i, 1)) Then
                    t = t + 1: .Item(a(i, 1)) = t
                    b(1, t) = a(i, 1)
                End If
                b(dico(a(i, 2)), .Item(a(i, 1))) = a(i, 3)
            Next
        End With
        'Restitution et mise en forme
        With .Offset(, .Columns.Count + 1)
            .CurrentRegion.Clear
            .Cells(1).Resize(n, t).Value = b
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
                With .Rows(1).Offset(, 1).Resize(, .Columns.Count - 1)
                    .Interior.ColorIndex = 38
                    .BorderAround Weight:=xlThin
                End With
                With .Columns(1).Offset(1).Resize(.Rows.Count - 1)
                    .Interior.ColorIndex = 43
                    .BorderAround Weight:=xlThin
                End With
                .Columns.AutoFit
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Rechercher des sujets similaires à "transformation tableau"