XL 2016 Lister les titres d'un tableau en fonction des paramètres

bnolwalid

XLDnaute Junior
Bonjour,
J'aurais besoin d'une macro ou d'une formule qui me liste l'ensemble des titres d'un tableau.
Le critère est l'existante du chiffre 1 sur la ligne de chaque paramètre.

voici un exemple :

Base de données
titre1 titre2 tire 3 titre 4 .............
para1 1 0 0 1
para2 0 1 1 0
para3 0 0 0 1
....

Résulta souhaité sur une nouvelle feuille :
para1 : titre1 titre 4
para2 titre2 titre3
para3 titre4


Pour info, la base de données évolue en terme de lignes et de colonne.

Désolé si je n'étais pas clair et merci d'avance pour votre aide

crdlmt
 

chris

XLDnaute Barbatruc
Bonjour

Faisable par Powerquery intégré à Excel
1652423539788.png


Actualiser par Données, Actualiser tout quant la source évolue
 

Pièces jointes

  • TransposerTitres_PQ.xlsx
    19.6 KB · Affichages: 3

chris

XLDnaute Barbatruc
RE

PowerQuery se base sur les titres des colonnes comme le montre l'image que j'ai jointe, donc si tes titres ne sont pas les mêmes cela ne peut fonctionner.

Ce pourquoi on demande de joindre un fichier représentatif ou à minima une copie d'écran...
 

bnolwalid

XLDnaute Junior
Re Hello,
Malheureusement, mes titres et paramètres changent d'une tout le temps c'est pour celà que je voulais rester sur un exemple générique.
du coup une solution par macro ou par formule?
merci encore une fois de ton aide

Crdlmt
 

job75

XLDnaute Barbatruc
Bonjour bnolwalid, chris,

Pour ceux qui préfèrent le VBA voyez le fichier joint et cette macro dans le code de la feuille "Résultat" :
VB:
Private Sub Worksheet_Activate()
Dim tablo, ncol%, colmax%, i&, col%, j%
tablo = Sheets("BDD").[A1].CurrentRegion 'matrice, plus rapide
If Not IsArray(tablo) Then tablo = [A1:B1] 'sécurité si la feuille est vide
ncol = UBound(tablo, 2)
colmax = 1
For i = 2 To UBound(tablo)
    col = 1
    For j = 1 To ncol
        If tablo(i, j) = 1 Then 'on s'appuie sur le chiffre 1
            col = col + 1
            tablo(i, col) = tablo(1, j)
            If col > colmax Then colmax = col
        End If
    Next j
    For j = col + 1 To ncol
        tablo(i, j) = "" 'RAZ à droite
Next j, i
For j = 2 To colmax: tablo(1, j) = j - 1: Next j
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
UsedRange.EntireColumn.Delete 'RAZ
With [A1] '1ère cellule de restitution
    .Resize(i - 1, colmax) = tablo
    .CurrentRegion.Borders.Weight = xlThin 'bordures
End With
End Sub
Elle se déclenche quand on active la feuille.

Elle est très rapide car elle utilise un tableau VBA.

Edit : par sécurité j'ai ajouté If Not IsArray(tablo) Then tablo = [A1:B1]

A+
 

Pièces jointes

  • TransposerTitres(1).xlsm
    24.1 KB · Affichages: 1
Dernière édition:

Discussions similaires