Transformation d'un tableau de données

Bonjour à tous

Je suis nouveau le forum et j’espère pouvoir trouver des éléments de réponses au problème que je rencontre actuellement sur Excel, alors je vous explique : je dois transformer un tableau afin qu'il soit plus lisible et que je puisse l'exploiter et interpréter les résultats, c'est un tableau qui contient plusieurs milliers de lignes. la structure du tableau est la suivante : des industries disons : industriel A , industriel B et Industriel D (le nombre d'industries dépend du fichier) elles rejettent toutes des substances, disons que ces substances sont les substances 1, substances 2 substances 3, ect (sachant que j'ai 14 substances émises potentiellement par chaque industriel) j'espère que c'est toujours clair le problème c'est que actuellement à chaque substance émise par une industrie correspond une ligne (sous cette forme:

Industrie A substance 1

Indusrie A substance 4

Industries A substance 7

Je souhaiterai pour simplifier la lecture (et l'interprétation surtout) que chaque industrie soit uniquement sur une seule ligne et que les substances émises sur la même ligne avec 1 si la substance est émise ou 0 si elle ne l'est pas (pour pouvoir faire des sommes de lignes et dire au final combien de substances sont émises par chaque industrie et pouvoir avoir le détail dans le tableau)

J'ai conscience que ça a l'air un peu incompréhensible donc je joint un fichier excel avec un exemple pour que ce soit plus clair

je pense que la solution c'est la macro mais je suis beaucoup trop mauvais

Voilà merci beaucoup pour votre aide !!!

Bonjour,

Tu peux utiliser un TCD

A+

Merci beaucoup pour ta réponse ! je vais tenter le tableau croisé dynamique une seconde fois. Je l'ai déja fais mais ça ne donne pas ce résultats tu as inséré un TCD uniquement ou bien tu as spécifié le type de tableau ???

Bonjour,

J'ai sélectionné la plage des données (avec en-têtes), j'ai effectué une insertion de TCD puis j'ai placé la liste des substances en colonnes, la liste des établissements en lignes et le nombre de liste des substances en valeurs.

A+

Bonjour !

je vais tenter ça encore merci

Bonne journée !

Bonjour le fil,

Teste ceci :

Option Explicit

Sub test()
Dim a, b(), i As Long, n As Long, t As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Range("b1").CurrentRegion
        a = .Value: ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
        b(1, 1) = a(1, 1): n = 1: t = 1
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not dico.exists(a(i, 2)) Then
                    t = t + 1
                    dico(a(i, 2)) = t
                    If UBound(b, 2) < t Then
                        ReDim Preserve b(1 To UBound(b, 1), 1 To UBound(b, 2) + 10)
                    End If
                    b(1, t) = a(i, 2)
                End If
                If Not .exists(a(i, 1)) Then
                    n = n + 1
                    .Item(a(i, 1)) = n
                    b(n, 1) = a(i, 1)
                End If
                b(.Item(a(i, 1)), dico(a(i, 2))) = 1
            Next
        End With
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 2).Resize(n, t)
            .CurrentRegion.Clear: .Value = b
            .Cells(1, .Columns.Count + 1).Value = "Total"
            .Cells(2, .Columns.Count + 1).Resize(.Rows.Count - 1).Formula = "=sum(rc[-" & .Columns.Count - 1 & "]:rc[-1])"
            On Error Resume Next
            .SpecialCells(4).Value = 0
            On Error GoTo 0
            With .CurrentRegion
                .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 - 2)
                        .Interior.ColorIndex = 40
                    End With
                    .Cells(.Columns.Count).Interior.ColorIndex = 38
                End With
                With .Columns(1)
                    .HorizontalAlignment = xlCenter
                    With .Offset(1).Resize(.Rows.Count - 1)
                        .Interior.ColorIndex = 36
                    End With
                    .Cells(1).Interior.ColorIndex = 37
                End With
                .Columns.AutoFit
            End With
        End With
        Set dico = Nothing
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour Klin89

Tu es clairement le génie de la Macro, ça marche !

Merci beaucoup pour ton aide, ça me donne envie d'apprendre à en faire

Bonne journée !

Bojour Klin89

Encore merci pour ta macro qui marche parfaitement pour les substances mais je me permet de te poser une autres question mon fichier initiale était plus complexe, je pensais qu'en le séparant en deux partie (une partie substance et une partie adresse) ça rendrait la macro plus simple sauf que je me suis trompé je t'explique un peu la problématique il se trouve que sur mon fichier original j'ai en colonne C les adresses des établissement qui émettent les substances lorsque l'établissement A par exemple à une seule adresse ça ne pose aucun problème je peux utiliser la macro pour mettre en page les substances ensuite prendre les adresses sans doublons dans le fichier pour remonter au fichier d'origine, mais le problème se pose lorsque un établissement B par exemple est présent à deux adresses différentes il faudrait donc que le programme prenne en considération les adresses avant de faire la somme des substances pour une entreprise se trouvant à cette adresse et considérer l'entreprise B (toujours le même nom) mais qui se trouve à une adresse différente comme une autre entreprise

La solution que j'ai trouver c'es de changer les noms des entreprises par exemple l'entreprise B en entreprise B1 et B2 jusqu'a l'entreprise Bn (suivant les adresses de 1 à n )

le souci c'est que je le fais à la main et mon fichier fais plusieurs milliers de lignes

Du coup la solution selon moi c'est verifier le nom de l'entreprise en premier, ensuite l'adresse pour passer aux substances (je n'ai aucune idée de comment l'écrire en macro )

Voilà

je remets le fichier excel pour que ce soit plus clair

Merci beaucoup pour votre aide

Re Breteche16

Comme ceci :

Option Explicit

Sub test()
Dim a, b(), i As Long, n As Long, t As Long, txt As String, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Range("b1").CurrentRegion
        a = .Value: ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
        b(1, 1) = a(1, 1): b(1, 2) = a(1, 3)
        n = 1: t = 2
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not dico.exists(a(i, 2)) Then
                    t = t + 1
                    dico(a(i, 2)) = t
                    If UBound(b, 2) < t Then
                        ReDim Preserve b(1 To UBound(b, 1), 1 To UBound(b, 2) + 10)
                    End If
                    b(1, t) = a(i, 2)
                End If
                txt = Join$(Array(a(i, 1), a(i, 3)), Chr(2))
                If Not .exists(txt) Then
                    n = n + 1
                    .Item(txt) = n
                    b(n, 1) = a(i, 1): b(n, 2) = a(i, 3)
                End If
                b(.Item(txt), dico(a(i, 2))) = 1
            Next
        End With
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 2).Resize(n, t)
            .CurrentRegion.Clear: .Value = b
            .Cells(1, .Columns.Count + 1).Value = "Total"
            .Cells(2, .Columns.Count + 1).Resize(.Rows.Count - 1).Formula = "=sum(rc[-" & .Columns.Count - 2 & "]:rc[-1])"
            On Error Resume Next
            .SpecialCells(4).Value = 0
            On Error GoTo 0
            With .CurrentRegion
                .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(, 2).Resize(, .Columns.Count - 3)
                        .Interior.ColorIndex = 40
                    End With
                    .Cells(.Columns.Count).Interior.ColorIndex = 38
                End With
                With .Columns("a:b")
                    .HorizontalAlignment = xlCenter
                    With .Offset(1).Resize(.Rows.Count - 1)
                        .Interior.ColorIndex = 36
                    End With
                    .Rows(1).Interior.ColorIndex = 37
                End With
                .Columns.AutoFit
            End With
        End With
        Set dico = Nothing
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour Klin89

ça marche !!! Merci beaucoup et bonne journée