Transformation Base vs Table

Bonjour à tous,

Une fois de plus je me permets de vous solliciter car je souhaiterai transformer ma base sous la forme d'une table, je m'explique:

J'ai un fichier composé de plusieurs colonnes, chacune des colonnes comporte des cellules vides ou non vides.

Je souhaiterai créer une table dans une autre feuille, composée des intitulés des colonnes de la base dans la première colonne de la nouvelle feuille et de tous les éléments non vide hors répétition dans la seconde colonne. C'est à dire qu'un élément de la colonne de la feuille "Base" intégré dans la seconde colonne de la table final ne doit pas apparaître deux fois pour un même intitulé. A noter que les intitulés présents dans la première colonne de la table se répètent autant de fois qu'il y a d'éléments à intégrer dans la seconde colonne.

Je vous ai joint un fichier pour que cela soit plus compréhensible, le premier onglet est la base et le second la table souhaitée au final.

Un grand merci à tous pour votre aide,

nfmel

Bonsoir,

A+

Merci Frangy, j'aime beaucoup la façon dont tu construis tes macros. Par contre j'ai du mal à comprendre à quoi sert la variable :

Dico = CreateObject("Scripting.dictionary")

Encore merci pour ta réponse,

a+, nfmel

Le dictionnaire est très utilisé pour obtenir facilement une liste sans doublon et dans ton projet c’est ce que l’on cherche, une liste sans doublon pour chaque colonne.

A+

Ok merci Frangy,

a+

Bonsoir,

bon, même si j'arrive après la bataille (comme d'hab !!!) une autre méthode.

Bonjour Frangy,

Lorsque je fais tourner la macro, si toutes les cellules sont vides dans la colonne de la feuille "Base" alors le programme m'affiche dans la colonne "B" de la feuille table l'intitulé de la colonne et non pas une cellule vide. J'ai essayé de modifier le code, mais sans succès!

Pourrais-tu une fois de plus m'aider?

Un grand merci,

nfmel

Merci pour ta réponse Game Over!

a+

Bonjour,

Essaie comme cela

Sub Test()
Dim WsS As Worksheet, WsC As Worksheet
Dim Dico
Dim C As Range, DerCel As Range
Dim Col As Integer
    Application.ScreenUpdating = False
    Set WsS = Worksheets("Base")
    Set WsC = Worksheets("Table")
    For Col = 1 To WsS.Cells(1, Columns.Count).End(xlToLeft).Column
        If WsS.Cells(Rows.Count, Col).End(xlUp).Row > 1 Then
            Set Dico = CreateObject("Scripting.dictionary")
            For Each C In WsS.Range(WsS.Cells(2, Col), WsS.Cells(Rows.Count, Col).End(xlUp))
                If Not Dico.Exists(C.Value) And C.Value <> "" Then
                    Dico.Add C.Value, C.Value
                    WsC.Range("A" & WsC.Range("A" & Rows.Count).End(xlUp).Row + 1) = CStr(Format(WsS.Cells(1, Col), "000"))
                    WsC.Range("B" & WsC.Range("A" & Rows.Count).End(xlUp).Row) = C.Value
                End If
            Next C
            Set Dico = Nothing
        Else
            WsC.Range("A" & WsC.Range("A" & Rows.Count).End(xlUp).Row + 1) = CStr(Format(WsS.Cells(1, Col), "000"))
        End If
    Next Col
    Set WsC = Nothing: Set WsS = Nothing
End Sub

A+

Merci Frangy, ça marche! Le seul truc c'est que lorsque je relance la macro elle affiche des données en dessous des données obtenues lors du premier lancement, mais au moins j'ai l'information!

a+

Tu peux effacer la plage destination avant d'effectuer une nouvelle copie

Sub Test()
Dim WsS As Worksheet, WsC As Worksheet
Dim Dico
Dim C As Range, DerCel As Range
Dim Col As Integer, DerCol As Integer
Dim DerLig As Long
    Application.ScreenUpdating = False
    Set WsS = Worksheets("Base")
    Set WsC = Worksheets("Table")
    DerLig = WsC.Range("A" & Rows.Count).End(xlUp).Row
    If DerLig > 1 Then WsC.Range(WsC.Range("A2"), WsC.Cells(DerLig, 2)).ClearContents
    DerCol = WsS.Cells(1, Columns.Count).End(xlToLeft).Column
    For Col = 1 To DerCol
        If WsS.Cells(Rows.Count, Col).End(xlUp).Row > 1 Then
            Set Dico = CreateObject("Scripting.dictionary")
            For Each C In WsS.Range(WsS.Cells(2, Col), WsS.Cells(Rows.Count, Col).End(xlUp))
                If Not Dico.Exists(C.Value) And C.Value <> "" Then
                    Dico.Add C.Value, C.Value
                    WsC.Range("A" & WsC.Range("A" & Rows.Count).End(xlUp).Row + 1) = CStr(Format(WsS.Cells(1, Col), "000"))
                    WsC.Range("B" & WsC.Range("A" & Rows.Count).End(xlUp).Row) = C.Value
                End If
            Next C
            Set Dico = Nothing
        Else
            WsC.Range("A" & WsC.Range("A" & Rows.Count).End(xlUp).Row + 1) = CStr(Format(WsS.Cells(1, Col), "000"))
        End If
    Next Col
    Set WsC = Nothing: Set WsS = Nothing
End Sub

A+

Merci beaucoup!

a+

Merci beaucoup Frangy!

a+