Modification du module SansDoublonsTriésMAC

Bonjour,

Tout d'abord merci à tous les contributeurs de ce forum que je parcours très fréquemment !

Je fais face actuellement à un problème d'utilisé le module SansDoublonsTritésMAC qui s'affiche les résultats par ligne et je souhaité d'affiché par colonne.

Avez-vous une idée pour m'aider ?

Merci,

Bonjour,

A la vue du titre du sujet, vous êtes sur MAC ?

Est-ce cela vous convient sans formule dans le tableau de droite à partir du choix en D3 ?
Si oui, je vous donne le code que je préparé

Cordialement

Merci Dan,

oui c'est le MAC, essaie de de télécharger le fichier Excel pour mieux comprendre mon problème, je n'avais pas d'expérience de codage, j'ai trouvé ce classeur d'Excel sur le web et je besoin d'aide pour l'adapté à la résultat souhaité.

Cordialement

Re,

- Supprimez les formules de N3 à T16
- Allez dans l'éditeur VBA et dans la fenêtre VBAproject, double cliquez sur la feuille--> (feuil2)DONNEES
- Dans la fenêtre collez le code ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("D3")) Is Nothing Then
    Dim c As Range
    Dim tablo As Collection
    Dim item
    Dim lig As Byte

    Set tablo = New Collection
    With Sheets("Donnees")
        On Error Resume Next
        For Each c In .ListObjects("Tableau1").ListColumns(1).Range
            If c.Offset(0, 1).Value = Range("D3").Value Then
                tablo.Add c.Value, CStr(c.Value)
            End If
        Next c

        With .ListObjects("Tableau2")
            lig = WorksheetFunction.Match(Range("D3"), .ListColumns(1).DataBodyRange, 0)
            If lig = 0 Then Exit Sub 'sortie du code si pas de valeur égale à D3 dans colonne M
            col = 2
            Union(.DataBodyRange(lig, col), .DataBodyRange(lig, .ListColumns.Count)).ClearContents
            For Each item In tablo
                .DataBodyRange(lig, col).Value = item
                col = col + 1
            Next item
        End With
        On Error GoTo 0
    End With
End If
End Sub

- Enregistrez votre fichier au format XLSM

Faites un test en changeant la valeur en D3

NB : Bien entendu, vous devez toujours avoir les valeurs X, Y et Z dans la colonne M.

Si ok, vous n'avez plus besoin des colonnes E et F ainsi que des codes placés dans le module

Bonjour Dan, merci beaucoup de votre effort;

J'ai vécu ces étapes, ça marche bien, mais je besoin de travaille seulement avec les colonnes de M à T et supprimé définitivement les colonnes de D à F.

Donc les conductions sera incluse automatiquement à la colonne M, une fois quand on fait remplir les donnée au tableau1 les résultats (avec la condition Unique de la colonne M ) sont apparaître au tableau2.

Mes Salutation Dan

Bonjour

J'ai vécu ces étapes, ça marche bien, mais je besoin de travaille seulement avec les colonnes de M à T et supprimé définitivement les colonnes de D à F.

Donc vous n'utilisez plus la colonne D avec sa liste déroulante ? Si oui il faut revoir tout le code

En gros ce que vous voulez c'est transposer les infos du tableau de gauche en tableau de droite

Re,

Exactement, c'est ce que je veux. c'est transposé les infos du tableau de gauche en tableau de droite. et je n'utilisé plus la colonne D avec sa liste déroulante.

Re,

En premier le code que je vous ai donné ne sert plus puisque vous n'utilisez pas la liste en D3.

- Supprimez les codes qui se trouvent dans le module
- Supprimez tout le code que vous avez dans la feuille DONNEES et remplacez-le par les deux codes ci-dessous

1. Code pour la liste en colonne M

Dim stpevt As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or stpevt = True Then Exit Sub

If Not Intersect(Target, ListObjects("Tableau1").ListColumns(2).DataBodyRange) Is Nothing Then
    Dim c As Range
    Dim tablo As Collection
    Dim item
    Dim lig As Byte

    Set tablo = New Collection
    With Sheets("Donnees")
        On Error Resume Next
        For Each c In .ListObjects("Tableau1").ListColumns(2).DataBodyRange
            tablo.Add c.Value, CStr(c.Value)
        Next c

        stpevt = True

        With .ListObjects("Tableau2")
            .DataBodyRange.Delete
            .ListRows.Add: lig = 1
            For Each item In tablo
                .DataBodyRange(lig, 1).Value = item
                Call donnees(item, lig)
                lig = lig + 1
            Next item
        End With
        stpevt = False
        On Error GoTo 0
    End With
End If
End Sub

2. Code pour les colonnes N à T

Sub donnees(item, lig As Byte)
Dim tablo2 As Collection
Dim c As Range
Dim valeur
Dim col As Byte

Set tablo2 = New Collection

On Error Resume Next
For Each c In ListObjects("Tableau1").ListColumns(1).DataBodyRange
    If c.Offset(0, 1).Value = item Then
        tablo2.Add c.Value, CStr(c.Value)
    End If
Next c
With ListObjects("Tableau2")
    col = 2
    For Each valeur In tablo2
        .DataBodyRange(lig, col).Value = valeur
        col = col + 1
    Next valeur
End With
End Sub

Le code traite le doublon en colonne B.
Dès que vous changerez ou ajouterez une donnée en colonne B du tableau de gauche, le tableau de droite sera remis à jour

NB : vous pouvez supprimer les colonnes D, E et F ainsi que la liste que vous avez en colonne A en dessous de la ligne 16

Si ok, pensez à

Cordialement

Ça marche bien. Merci beaucoup Dan, c'est exactement ce que je voulais. merci mes salutations