XL 2013 Titres à plusieurs niveaux

[MinstrelL]

Bonjour le forum !

J'essaie de réaliser un tableau de suivi budgétaire et j'aimerais pouvoir de la même manière que sur Word, classer mes différentes dépenses dans des titres bien définis.
L'idée est de reproduire la fonction liste à plusieurs niveaux sur Word mais sur Excel.

J'ai cherché par l'intermédiaire d'un code VBA mais trop compliqué pour moi hélas...

J'ai joint le fichier Excel avec un exemple de ce que je souhaite réaliser. Pour aller un peu plus dans les détails, je voudrais que ce soit le retrait de mes titres qui détermine le niveau de la liste. Je souhaite aller jusqu'au niveau 3 et que le code soit applicable sur les colonnes A et B. Enfin, la modification d'un retrait (donc niveau) d'un des titres mettrait à jour tous les autres.

Pas facile cette affaire

Merci pour votre aide bien précieuse,

Je reste à votre écoute pour tout complément.

Bien à vous,

Paul

 

[chris]

Bonjour

Vouloir faire du traitement de texte avec un tableur n'est pas un bonne idée, surtout si tu compte faire des calculs.
Si vraiment tu veux décaler utilise des colonnes différentes : le rendu sera identique mai plus facile à gérer.
et c'est la colonne qui permettra de comprendre le niveau...

Si tu ne prévois aucun calcul, pourquoi ne pas utiliser Word ?

 

[MinstrelL]

Bonjour Chris,

Je comprends. L'idée est bien de faire des calculs sur les colonnes suivantes. J'ai volontairement, dans ce tableur, écarter le traitement des titres pour pouvoir l'incorporer dans mon tableau avec calculs.

En ce qui concerne ton idée, Je serais également partant pour gérer les titres, non pas avec les retraits, mais pourquoi pas avec les colonnes. Par exemple :

• Numérotation ==> colonne A
• Titre 1 ==> colonne B
• Titre 2 ==> colonne C
• Titre 3 ==> colonne D

Plus facile peut-être de cette manière

Merci,

Je reste à votre écoute pour tout complément,

Bien à vous,

Paul

 

[mromain]

Bonsoir MinstrelL, chris, le forum,

Vouloir faire du traitement de texte avec un tableur n'est pas un bonne idée

Tout à fait d'accord avec @chris sur ce point-là...

Celà étant dit, tu trouveras une approche dans le classeur ci-joint.
La solution passe par une fonction perso qui sert à afficher la numérotation du titre en fonction de son niveau (et des autres titres situés au-dessus).

Cette fonction est volatile et se recalcule souvent. Elle peut donc amener des lenteurs à l'usage.
De plus, il faut être rigoureux à l'usage (voir l'exemple du titre niveau 5 n'ayant pas de titre niveau 4 parent).

A+

 

[chris]

Bonjour Chris,

Je comprends. L'idée est bien de faire des calculs sur les colonnes suivantes. J'ai volontairement, dans ce tableur, écarter le traitement des titres pour pouvoir l'incorporer dans mon tableau avec calculs.

En ce qui concerne ton idée, Je serais également partant pour gérer les titres, non pas avec les retraits, mais pourquoi pas avec les colonnes. Par exemple :

• Numérotation ==> colonne A
• Titre 1 ==> colonne B
• Titre 2 ==> colonne C
• Titre 3 ==> colonne D

Plus facile peut-être de cette manière

Merci,

Je reste à votre écoute pour tout complément,

Bien à vous,

Paul

Bonjour à tous

Dans ce cas un code de numérotation sera plus simple...

Je lasse les Vbistes poursuivre...

 

[MinstrelL]

Hello,

Merci pour vos réponses.
J'aime bien ton idée @mromain, je trouve ça simple d'utilisation. J'aimerais cependant que la fonction puisse être utilisé dans une formule pour permettre la numérotation des titres en fonction de certaines colonnes remplies.

Je m'explique :
Par exemple, dans la cellule A1, une formule comme : SI(NBVAL(B2);TitreNiveau(1);"")
Je pourrais utiliser la formule également de manière incrémentée pour la colonne C pour TitreNiveau(2) et D pour TitreNiveau(3).

J'ai essayé avec ta fonction perso mais cela ne fonctionne pas.

J'ai inséré ci-joint mon exemple avec ton idée.

Merci !

 

[mromain]

Bonjour à tous,

@MinstrelL

En modifiant le code de la fonction comme suit, tu peux arriver facilement à ce que tu veux.

Code de la fonction TitreNiveau :

Function TitreNiveau(niveau As Long) As String
Const c_s_formulaPattern As String = "=TitreNiveau("
Dim l_o_rngSearch As Excel.Range
Dim l_o_dico As Object
Dim l_o_ws As Excel.Worksheet
Dim l_l_lvl As Long
Dim l_l_lastCol As Long
Dim l_s_rngFormula As String


    Application.Volatile
    
    Set l_o_dico = CreateObject("Scripting.Dictionary")
    Set l_o_rngSearch = Application.Caller
    Set l_o_ws = Application.Caller.Worksheet
    
    With l_o_ws
        l_l_lastCol = .UsedRange(1, 1).Column + .UsedRange.Columns.Count - 1
        While Not l_o_rngSearch Is Nothing
            
            l_s_rngFormula = l_o_rngSearch.Formula
            If l_s_rngFormula Like c_s_formulaPattern & "*" Then
                
                l_s_rngFormula = Replace(l_s_rngFormula, c_s_formulaPattern, vbNullString)
                l_l_lvl = CLng(Application.Evaluate("=" & Left(l_s_rngFormula, InStr(l_s_rngFormula, ")") - 1)))
                If Not l_o_dico.Exists(l_l_lvl - 1) Then l_o_dico(l_l_lvl) = l_o_dico(l_l_lvl) + 1
                
            End If
            If l_o_rngSearch.Row > 1 Then
                Set l_o_rngSearch = .Range(.Cells(1, 1), .Cells(l_o_rngSearch.Row - 1, l_l_lastCol)).SpecialCells(xlCellTypeFormulas).Find(c_s_formulaPattern, , xlFormulas, xlPart, xlByColumns, xlPrevious, False)
            Else
                Set l_o_rngSearch = Nothing
            End If
        Wend
    End With
    For l_l_lvl = 1 To niveau
        If l_o_dico.Exists(l_l_lvl) Then
            TitreNiveau = TitreNiveau & l_o_dico(l_l_lvl) & "."
        Else
            TitreNiveau = TitreNiveau & "X" & "."
        End If
    Next l_l_lvl
    TitreNiveau = TitreNiveau & " "
    
    Set l_o_rngSearch = Nothing
    Set l_o_ws = Nothing
    Set l_o_dico = Nothing
End Function

Ensuite, saisir en A2 la formule suivante et la tirer vers le bas :

=TitreNiveau(EQUIV("*";B2:D2;)*1)

A+

 

[MinstrelL]

Hello,

Je suis épaté !
C'est exactement ce que je cherchais. Mille merci à toi @mromain et aux autres pour toute votre attention.

A bientôt !

Paul

 

[MinstrelL]

Hello,

Dernière petite requête @mromain , est-il possible de traiter l'affichage "#VALEUR!" lorsque la formule ne détecte rien dans les colonnes "Titres" ?
J'ai essayé avec un "SIERREUR" mais sans succès...

Merci beaucoup

 

[mromain]

Re-bonjour,

Effectivement ça ne fonctionnera pas avec SIERREUR.
Le mieux niveau performances, vu que la fonction est volatile (et donc s'évalue à chaque changement dans la feuille), serait d'inscrire la formule uniquement sur les "lignes de titre".
Ainsi, tu éviteras d'avoir calculer la fonction sur les lignes inutiles.

Est-ce ue cette solution te convient ? ou souhaites-tu tout de même modifier la fonction pour éviter les #VALEUR! sur les lignes "sans titre" ?

A+

 

[MinstrelL]

Re @mromain,

Je comprends. J'ai contourné l'affichage avec une mise en forme conditionnelle "=SIERREUR($A2)" et une police en blanc du coup.... pas terrible.

En fait, les titres ne sont pas toujours sur les mêmes lignes et peuvent varier d'endroit, c'est pourquoi j'aimerais corriger l'erreur lorsque la formule ne détecte pas de titre.

Pour conclure, une mise à jour du code prenant en compte les lignes sans titres serait top !

Merci beaucoup beaucoup, c'est très aimable !

 

[mromain]

Re-bonjour,

Ci-dessous le code de la fonction retouché pour prendre en compte l'encapsulation dans SIERREUR :

Function TitreNiveau(niveau As Long) As String
Const c_s_formulaPattern As String = "TitreNiveau("
Dim l_o_rngSearch As Excel.Range
Dim l_o_dico As Object
Dim l_o_ws As Excel.Worksheet
Dim l_l_lvl As Long
Dim l_l_lastCol As Long
Dim l_s_rngFormula As String


    Application.Volatile
    
    Set l_o_dico = CreateObject("Scripting.Dictionary")
    Set l_o_rngSearch = Application.Caller
    Set l_o_ws = Application.Caller.Worksheet
    
    With l_o_ws
        l_l_lastCol = .UsedRange(1, 1).Column + .UsedRange.Columns.Count - 1
        While Not l_o_rngSearch Is Nothing
            
            l_s_rngFormula = l_o_rngSearch.Formula
            If l_s_rngFormula Like "=" & c_s_formulaPattern & "*" Then
                l_s_rngFormula = Replace(l_s_rngFormula, "=" & c_s_formulaPattern, vbNullString)
            ElseIf l_s_rngFormula Like "=IFERROR(" & c_s_formulaPattern & "*" Then
                l_s_rngFormula = Replace(l_s_rngFormula, "=IFERROR(" & c_s_formulaPattern, vbNullString)
            End If
            If Not l_s_rngFormula Like vbNullString Then
                l_l_lvl = CLng(Application.Evaluate("=" & Left(l_s_rngFormula, InStr(l_s_rngFormula, ")") - 1)))
                If Not l_o_dico.Exists(l_l_lvl - 1) Then l_o_dico(l_l_lvl) = l_o_dico(l_l_lvl) + 1
                
            End If
            If l_o_rngSearch.Row > 1 Then
                Set l_o_rngSearch = .Range(.Cells(1, 1), .Cells(l_o_rngSearch.Row - 1, l_l_lastCol)).SpecialCells(xlCellTypeFormulas).Find(c_s_formulaPattern, , xlFormulas, xlPart, xlByRows, xlPrevious, False)
            Else
                Set l_o_rngSearch = Nothing
            End If
        Wend
    End With
    For l_l_lvl = 1 To niveau
        If l_o_dico.Exists(l_l_lvl) Then
            TitreNiveau = TitreNiveau & l_o_dico(l_l_lvl) & "."
        Else
            TitreNiveau = TitreNiveau & "X" & "."
        End If
    Next l_l_lvl
    TitreNiveau = TitreNiveau & " "
    
    Set l_o_rngSearch = Nothing
    Set l_o_ws = Nothing
    Set l_o_dico = Nothing
End Function

Tu peux donc utiliser la fonction ainsi en A2 :

=SIERREUR(TitreNiveau(EQUIV("*";B2:D2;));"")

A+

 

[MinstrelL]

Merci beaucoup !!
Manque plus qu'à comprendre le code

A bientôt !

Paul