Passer d'un tableau à une liste

Bonjour le forum,

J'ai un tableau à deux entrées : En ligne les modèles, en colonne les pièces. Chaque fois qu'une pièce est présente dans un modèle elle est repérée par un X. J'aimerais, sur la base de ce tableau, pouvoir établir une liste de pièces pour chaque modèle comme sur le fichier joint. Quelqu’un aurait une idée?

Merci d'avance de votre aide.

François

bonjour

un essai aadapter en changeant les dimensions des plages

sans matricielle ni vba

cordialement

Bonjour,

Salut tulipe,

une solution en VBA

Sub Tableau2()
Dim Lg%, x%, y%
Dim firstAddress$, c As Range
    Application.ScreenUpdating = False
    Lg = Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Range("a13:f" & Lg).ClearContents   'efface

    With Range("b3:f8")                     'à régler
        Set c = .Find("x", LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                x = Range(c.Address).Row
                y = Range(c.Address).Column - 1
                Cells(65000, y).End(xlUp)(2) = Cells(x, "a")
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

Amicalement

Claude

Tulipe,

Bien trouvé, merci! Sans matrice et sans VBA, c'est top, par contre vu la complexité et la taille du tableau, ça va être coton à implémenter.

Claude,

merci. Je vais voir après le repas.

Bon appétit.

re

faut voir

re,

C'est peut-être mieux de mettre le 2ème tableau sur une autre feuille ,

çà te laisse la place pour compléter le 1er.

Sub Tableau2()
Dim Lg%, x%, y%, f As Worksheet
Dim firstAddress$, c As Range
    Application.ScreenUpdating = False
    Set f = Sheets("Tablo2")
    Lg = Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
        f.Range("a4:f" & Lg).ClearContents   'efface

    With Range("b3:f" & Lg)
        Set c = .Find("x", LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                x = Range(c.Address).Row
                y = Range(c.Address).Column - 1
                f.Cells(65000, y).End(xlUp)(2) = Cells(x, "a")
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
            f.Activate
    End With
End Sub

Claude

Claude,

merci. Je vais étudier ta macro et tâcher de la mettre en place.