Simplification et organisation de donnees

Bonjour,

Je cale sur ce sujet , est ce que qlq aurait une astuce par le biais d'une macro ou autre pour qu'à partir du fichier joint avoir

La ref : en étiquette de ligne

Le Groupe : en étiquette de colonne

Et que le contenu : s'incrémente automatiquement

J'ai essayé par le biais d'un TCD, mais on ne peut pas rentrer de texte , mais seulement des valeurs ....

si qlqn a une astuce . Merci

16excel.xlsx (7.87 Ko)

Bonsoir,

Voilà une solution qui m'a l'air de fonctionner...

Sub RéorgTablo()
    Dim tbi, gr, k, d As Object, i%, j%, n%, ref$, tbf()
    tbi = ActiveSheet.Range("A1").CurrentRegion.Value
    Set d = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tbi, 1)
        k = tbi(i, 2)
        If InStr(1, gr, k) = 0 Then gr = gr & ";" & k
        k = tbi(i, 1) & "|" & k
        d(k) = tbi(i, 3)
    Next i
    gr = Split(gr, ";")
    ReDim tbf(UBound(gr), 0): tbf(0, 0) = "ref"
    For i = 1 To UBound(gr)
        tbf(i, 0) = gr(i)
    Next i
    Do While d.Count > 0
        For Each k In d.keys
            If ref = "" Then
                ref = Split(k, "|")(0)
                n = n + 1: ReDim Preserve tbf(UBound(gr), n)
                tbf(0, n) = ref
            End If
            If k Like ref & "*" Then
                For i = 1 To UBound(gr)
                    If k = ref & "|" & gr(i) Then
                        tbf(i, n) = d(k)
                        d.Remove (k): Exit For
                    End If
                Next i
            End If
        Next k
        ref = ""
    Loop
    With ActiveSheet.Range("A1")
        .CurrentRegion.ClearContents
        .Resize(n + 1, UBound(gr) + 1).Value = WorksheetFunction.Transpose(tbf)
    End With
End Sub

Je ne garantirai pas son optimalité... je fatigue un peu, et j'ai l'impression d'avoir fait des détours évitables... mais il convient de voir si elle donne bien le résultat voulu d'une part, puis si c'est OK évaluer le temps qu'elle met sur un tableau de plus grande dimension...

Cordialement.

8bru12-excel.xlsm (19.78 Ko)

Bonsoir M FERRAND,

Merci pour votre réponse (avec un peu de retard )

J'aimerai avoir les mêmes connaissance en macro ....

Nous avons testé , mais notre fichier de départ est très très lourd (en nombre de colonnes et de lignes ) du coup , impossible de tester cette macro , l'ordi rame .

Du coup nous, vu que nous ne voulions qu'une base de données , nous avons réussi à "obtenir" une base de données en croisant toutes les données , sur access (oui oui)...

En tout cas mille merci ... Bonne soirée

BRU12

Bonsoir MFerrand, BRU12, le forum

Tu peux essayer celle-ci

Il faut créer manuellement Feuil2 au préalable

Option Explicit
Sub test()
Dim a, b(), i As Long, n As Long, t As Long, dico1 As Object, dico2 As Object
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    With Sheets("feuil1").Range("a1").CurrentRegion
        a = .Value: ReDim b(1 To UBound(a, 1), 1 To 10)
        n = 1: t = 1
        For i = 2 To UBound(a, 1)
            If Not dico1.exists(a(i, 2)) Then
                t = t + 1
                dico1(a(i, 2)) = t
                If UBound(b, 2) < t Then
                    ReDim Preserve b(1 To UBound(b, 1), 1 To UBound(b, 2) + 50)
                End If
                b(1, t) = a(i, 2)
            End If
            If Not dico2.exists(a(i, 1)) Then
                n = n + 1
                dico2(a(i, 1)) = n
                b(n, 1) = a(i, 1)
            End If
            b(dico2(a(i, 1)), dico1(a(i, 2))) = a(i, 3)
        Next
    End With
    Application.ScreenUpdating = False
    'restitution et mise en forme
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Clear
        With .Resize(n, t)
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
                With .Offset(, 1).Resize(, .Columns.Count - 1)
                    .Interior.ColorIndex = 44
                End With
            End With
            With .Columns(1)
                .HorizontalAlignment = xlCenter
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Interior.ColorIndex = 36
                End With
            End With
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
    Set dico1 = Nothing: Set dico2 = Nothing
End Sub

klin89

Rechercher des sujets similaires à "simplification organisation donnees"