XL 2013 (RESOLU) Affichage des en-têtes de tableau selon l'ordre

chaelie2015 · 20 Octobre 2023

Bonsoir Forum
Je désire afficher les en-têtes du tableau situé dans la plage B2:AY52 dans la feuille intitulée 'Matrice d'écart,' plus précisément dans la plage BC2:BL52.
Mon objectif est d'organiser ces en-têtes en fonction des valeurs présentes dans chaque ligne, du plus grand au plus petit. Une fois que j'ai trié ces valeurs, je souhaite afficher les en-têtes correspondants à chaque valeur trouvée.
De plus, si plusieurs valeurs identiques se trouvent dans une ligne, je veux qu'elles soient également affichées dans le tableau BC2:BL52.
Pour des informations plus détaillées, je vous invite à consulter le fichier de test.

Exemple :
Nous commençons par la première ligne du tableau B2:AY52. La valeur la plus élevée est 56, qui se trouve dans les colonnes Lot_06, Lot_08 et Lot_10. Ensuite, nous avons la valeur 36, située dans la colonne Lot_05, suivie de la valeur 23, présente dans les colonnes Lot_01 et Lot_03. Mon souhait est que ces lots, à savoir Lot_06, Lot_08, Lot_10, Lot_05, Lot_01 et Lot_03, soient affichés respectivement dans la première ligne du tableau BC2:BL52.

Ce processus se répète pour la deuxième ligne du tableau B2:AY52 et ainsi de suite.
J'espère que mes explications étaient compréhensibles.
Merci

job75 · 23 Octobre 2023

La macro Worksheet_Change revue et corrigée :

VB:

Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [D2,D4]) Is Nothing Then Exit Sub
    Target.Select
    Tri
    '---D2---
    If Val([D2]) < 1 Then [D2] = 1
    Rows("7:60").Hidden = True
    Rows(7).Resize([D2]).Hidden = False
    Sheets("Matrice d'écart").Rows("2:51").Hidden = True
    Sheets("Matrice d'écart").Rows("2").Resize([D2]).Hidden = False
    '---D4---
    If Val([D4]) < 1 Then [D4] = 1
    Columns("D:BA").Hidden = True
    Columns("D").Resize(, [D4]).Hidden = False
    Columns("BD:MQ").Hidden = True
    Columns("BD").Resize(, 6 * [D4]).Hidden = False
End Sub

Bonne nuit.

job75 · 22 Octobre 2023

Cela dit la macro Tri ne donne pas les bons résultats, voyez plutôt celle-ci :

VB:

Sub Tri()
    Dim nom, nlot%, coldest%, nlig%
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    Application.Calculation = xlCalculationManual 'calcul manuel
    nom = [B7].Resize(50)
    For nlot = 1 To 50
        coldest = 6 * nlot + 51
        Cells(7, coldest).Resize(50) = nom
        Cells(7, coldest + 1).Resize(50) = Cells(7, nlot + 3).Resize(50).Value
        Cells(7, coldest).Resize(50, 2).Sort Cells(7, coldest + 1), xlAscending, Header:=xlNo 'tri
        nlig = Application.Count(Cells(7, coldest + 1).Resize(50))
        If nlig < 50 Then Cells(7, coldest).Offset(nlig).Resize(50 - nlig) = "" 'efface les noms sans montant
        Cells(7, coldest + 2).Resize(50) = ""
        If nlig > 1 Then Cells(7, coldest + 2) = Cells(8, coldest + 1) - Cells(7, coldest + 1)
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True 'réactive les évènements
End Sub

chaelie2015 · 22 Octobre 2023

Bonsoir Job
tu as résolu le problème précédent, mais un nouveau problème est survenu lors du classement, principalement avec les lots 03, 04 et 06. Le fichier ci-joint illustre le problème : il manque le classement dans chaque lot, ainsi que l'écart entre le classement 1 et 2.
Merci d'avance

chaelie2015 · 22 Octobre 2023

job75 à dit:

Cela dit la macro Tri ne donne pas les bons résultats, voyez plutôt celle-ci :

VB:

Sub Tri()
    Dim nom, nlot%, coldest%, nlig%
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    Application.Calculation = xlCalculationManual 'calcul manuel
    nom = [B7].Resize(50)
    For nlot = 1 To 50
        coldest = 6 * nlot + 51
        Cells(7, coldest).Resize(50) = nom
        Cells(7, coldest + 1).Resize(50) = Cells(7, nlot + 3).Resize(50).Value
        Cells(7, coldest).Resize(50, 2).Sort Cells(7, coldest + 1), xlAscending, Header:=xlNo 'tri
        nlig = Application.Count(Cells(7, coldest + 1).Resize(50))
        If nlig < 50 Then Cells(7, coldest).Offset(nlig).Resize(50 - nlig) = "" 'efface les noms sans montant
        Cells(7, coldest + 2).Resize(50) = ""
        If nlig > 1 Then Cells(7, coldest + 2) = Cells(8, coldest + 1) - Cells(7, coldest + 1)
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True 'réactive les évènements
End Sub

Bonsoir
Pardon, Job75, tu as été si rapide que je n'ai pas remarqué ta réponse après avoir envoyé mon message. Merci, tu as fourni la réponse que je recherchais.

Aussi, si tu permet, je souhaite masquer simultanément les lignes dans la feuille 'Matrice d'écart' en fonction de la valeur saisie dans la cellule D2 de la feuille 'BdD CEO'.
Merci par avance
A+

job75 · 23 Octobre 2023

La macro Worksheet_Change revue et corrigée :

VB:

Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [D2,D4]) Is Nothing Then Exit Sub
    Target.Select
    Tri
    '---D2---
    If Val([D2]) < 1 Then [D2] = 1
    Rows("7:60").Hidden = True
    Rows(7).Resize([D2]).Hidden = False
    Sheets("Matrice d'écart").Rows("2:51").Hidden = True
    Sheets("Matrice d'écart").Rows("2").Resize([D2]).Hidden = False
    '---D4---
    If Val([D4]) < 1 Then [D4] = 1
    Columns("D:BA").Hidden = True
    Columns("D").Resize(, [D4]).Hidden = False
    Columns("BD:MQ").Hidden = True
    Columns("BD").Resize(, 6 * [D4]).Hidden = False
End Sub

Bonne nuit.

job75 · 23 Octobre 2023

Bonjour chaelie2015, le forum,

J'ai encore simplifié la macro précédente, un seul test suffit.

A+

chaelie2015 · 23 Octobre 2023

job75 à dit:
Bonjour chaelie2015, le forum,

J'ai encore simplifié la macro précédente, un seul test suffit.

A+

Bonjour job 75, le forum,
Je tiens à exprimer ma gratitude, Job, pour votre réponse exceptionnelle et votre précieuse collaboration.
A+

XL 2013 (RESOLU) Affichage des en-têtes de tableau selon l'ordre

chaelie2015

XLDnaute Accro

Pièces jointes

job75

job75

XLDnaute Barbatruc

Pièces jointes

chaelie2015

XLDnaute Accro

Pièces jointes

chaelie2015

XLDnaute Accro

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

chaelie2015

XLDnaute Accro

Discussions similaires