Extraire paramètres (arguments) d'une fonction Excel en VBA

Salut MFerrand, forum,

MFerrand a écrit :

C'est sûrement ce morceau : "truc((" qui fausse la suite ! Deux parenthèses incluses dans un élément chaîne qui n'intervient pas dans le fonctionnement de la fonction.

Eh bien en faisant du pas à pas, ce cas est très bien géré par ton algo... si à la fin de cette formule on n'avait pas le &B1 !!

Sans le &B1 ça marche nickel !

Bonjour vba-new, et tous

Je n'ai pas pris le temps de faire un pas à pas pour voir où ça décrochait.

Ça me surprend que ce soit le &B1 final. J'aurais opté pour le déséquilibre introduit dans le décompte des parenthèses qui fait que le &B1 ne serait pas exclu de la fonction et qu'il manquerait de plus au final une parenthèse...

Comme j'ai par contre pris un moment pour introduire une gestion des caractères "critiques" par substitution, je livre la dernière version (jusqu'au prochain évènement imprévu !), qui me donne un bon résultat pour ta fonction.

Function ARGFCTN(pf As Range, rf As Integer)
    Dim i%, h%, k%, lf%, fa$, af
    fa = pf.Cells(1, 1).FormulaLocal
    If Left(fa, 1) = "=" Then 'On ôte le signe =
        lf = Len(fa) - 1
        fa = Right(fa, lf)
        Do
            h = InStr(k + 1, fa, Chr(34))
            If h > 0 Then k = InStr(h + 1, fa, Chr(34))
            If h > 0 And k > h Then
                For i = h + 1 To k - 1
                    If Mid(fa, i, 1) = "(" Then Mid(fa, i, 1) = Chr(139)
                    If Mid(fa, i, 1) = ")" Then Mid(fa, i, 1) = Chr(155)
                    If Mid(fa, i, 1) = ";" Then Mid(fa, i, 1) = Chr(134)
                Next i
            Else
                Exit Do
            End If
        Loop
        af = Split(fa, "(")
        For i = 0 To UBound(af)
            For h = Len(af(i)) To 1 Step -1
                k = Asc(Mid(af(i), h, 1))
                If k < 65 Or k > 90 Then
                    af(i) = Right(af(i), Len(af(i)) - h)
                    Exit For
                End If
            Next h
            If af(i) = "" Then af(i) = "@"
        Next i
        af = Join(af, ";")
        af = Replace(af, ";@", "")
        af = Replace(af, "@", "")
        af = Split(af, ";") 'Tableau des noms de fonctions incluses dans la formule
        If rf <= UBound(af) + 1 Then
            For i = 0 To rf - 1
                h = InStr(1, fa, af(i))
                h = InStr(h, fa, "(")
                lf = lf - h + 1
                fa = Right(fa, lf)
            Next i
            h = 0
            k = 0
            For i = 1 To lf
                If Mid(fa, i, 1) = "(" Then
                    h = h + 1
                ElseIf Mid(fa, i, 1) = ")" Then
                    k = k + 1
                    If k = h Then Exit For
                End If
            Next i
            If i <= lf Then
                lf = i - 2
                fa = Mid(fa, 2, lf) 'Arguments fonction (sans prenth. d'extrémités)
                h = 0
                For k = 1 To lf
                    If Mid(fa, k, 1) = "(" Then h = h + 1
                    If Mid(fa, k, 1) = ")" Then h = h - 1
                    If Mid(fa, k, 1) = ";" Then
                        If h = 0 Then Mid(fa, k, 1) = Chr(135)
                    End If
                Next k
                For k = 1 To lf
                    If Mid(fa, k, 1) = Chr(139) Then Mid(fa, k, 1) = "("
                    If Mid(fa, k, 1) = Chr(155) Then Mid(fa, k, 1) = ")"
                    If Mid(fa, k, 1) = Chr(134) Then Mid(fa, k, 1) = ";"
                Next k
                af = IIf(fa <> "", Split(fa, Chr(135)), "sans") 'Tableau des arguments
                ARGFCTN = af
                Exit Function
            End If
        End If
    End If
    ARGFCTN = CVErr(xlErrNA)
End Function

Bon week-end

Ferrand

Re MFerrand, forum,

J'ai essayé ton nouveau code avec la fonction citée plus haut et ça ne me renvoie que ça comme argument !

A2="blabla"
GAUCHE(A2;3)
"truc(("

Merci pour tes tentatives ! Mais ne t'embête pas plus, je t'ai sorti des cas tordus !!

Bonsoir,

Curieux ! Voilà mon résultat :

qadsyxa

Je ne m'embête pas ! Et les cas tordus, c'est ce qui fait le charme !!

Bonne soirée

Ferrand

Le problème se situe entre la chaise et le clavier...

J'avais mis 2 en 2è argument...

Ca marche nickel ! Bien joué MFerrand !

Je mets le post en résolu... et le rouvrirai en temps utile si je rencontre un cas non géré !!

Mais oui ! J'avais pas connecté. En mettant 2 tu as sorti les paramètres de la fonction SI...

A+

Bonjour,

En retard mais comme ce n'est qu'aujourd'hui qu'il n'a pas fait beau...

Un essai qui j'espère devrait être rapide, il n'y a pas beaucoup de traitement de chaine.

Pas complètement fini car j'envisageais une récursivité pour pouvoir demander les arguments de la fonction du 3ème argument de la fonction mère par exemple, mais pas fait encore. Donc arg1 ne sert pas.

Pour l'instant si tu veux le concatener() de B6 il faut boucler sur les arguments et rappeler argumentsF() avec celui qui commence par la fonction voulue.

Tu as un exemple d'appel sur feuille en D8:D15 et un exemple d'appel en vba (test)

A suivre... mais si tu veux tester si c'est la bonne direction et s'il y a un gain de temps.

Function argumentsF(ByVal cel As Range, Optional arg1 As Variant) As Variant
    Dim formule As String, ptrLIFO As Long, i As Long

    formule = cel.FormulaLocal
    i = InStr(formule, "(")
    If i = 0 Then
        argumentsF = "err fonction": Exit Function
    ElseIf Right(formule, 1) <> ")" Then
        argumentsF = "err fonction": Exit Function
    End If

    formule = Mid(formule, i + 1, Len(formule) - i - 1)
    For i = 1 To Len(formule)
        If ptrLIFO = 0 Then
            If Mid(formule, i, 1) = ";" Then
                formule = Left(formule, i - 1) & "µ" & Mid(formule, i + 1)
            End If
        End If
        Select Case Mid(formule, i, 1)
        Case "("
            ptrLIFO = ptrLIFO + 1
        Case ")"
            ptrLIFO = ptrLIFO - 1
        Case """"
            Do
                i = i + 1
            Loop Until Mid(formule, i, 1) = """"
        End Select
    Next i
    argumentsF = Application.Transpose(Split(formule, "µ"))
End Function

eric

Merci pour ta proposition Eric ! J'enlève le Résolu, je verrai pour le remettre plus tard...

J'ai fait 2-3 tests en prenant la version simple

=CONCATENER(SI(A2="blabla";GAUCHE(A2;3);"truc((");DROITE(A2;3);A3+MOIS(A4)+A12;A5*7)

Et je dois dire que c'est plutôt rapide avec un peu plus de 10 s pour mes 250 000 formules et des poussières !

Sauf qu'avec la version plus compliquée, ça se gâte un peu !

Effectivement, avec la formule de type :

=A1&CONCATENER(SI(A2="blabla";GAUCHE(A2;3);"truc((");DROITE(A2;3);A3+MOIS(A4)+A12;A5*7)&B1

Si tu mets en début de code, un :

    ElseIf Right(formule, 1) <> ")" Then
        argumentsF = "err fonction": Exit Function

C'est sûr que je n'aurais jamais mes arguments !!

Bonjour,

J'en étais resté à : extraire paramètres (arguments) d'une fonction excel.

Là ce n'est plus une fonction que tu lui passes, mais une formule.

Ca devient donc : Extraire les arguments de la 1ère fonction d'une formule, mais on rentre dans des cas particuliers qui vont être sans fin donc limite toi à ton besoin réel.

Adaptation à ce cas avec quelques autres petites modifs...

Toujours pas de récursivité qui résiste mais tu vois une autre piste qui introduit argF() qui appelle l'autre sans rien faire de plus, j'ai nettoyé pour ne pas embrouiller.

Function argumentsF(cel As Range, Optional num_arg As Long) As Variant
    Dim formule As String, ptrLIFO As Long, i As Long

    formule = cel.FormulaLocal
    i = InStr(formule, "(")

    If i > 0 Then
        formule = Mid(formule, i + 1, Len(formule) - i - 1)
    End If

    For i = 1 To Len(formule)
        If ptrLIFO = 0 Then
            If Mid(formule, i, 1) = ";" Then
                formule = Left(formule, i - 1) & "µ" & Mid(formule, i + 1)
            End If
        End If
        Select Case Mid(formule, i, 1)
        Case "("
            ' incrémenter niveau de ()
            ptrLIFO = ptrLIFO + 1
        Case ")"
            ' décrémenter niveau de ()
            ptrLIFO = ptrLIFO - 1
            If ptrLIFO < 0 Then
                ' la formule est concaténée avec &, on coupe
                formule = Left(formule, i - 1)
                Exit For
            End If
        Case """"
            ' abstraction des chaines
            Do
                i = i + 1
            Loop Until Mid(formule, i, 1) = """"
        End Select
    Next i
    argumentsF = Split(formule, "µ")
End Function

Et une dernière version qui permet d'atteindre les arguments de n'importe quelle fonction d'une formule quelque soit sa profondeur dans les parenthèses.

Un peu prise de tête, à tester.

eric

Bonjour Eric

eriiic a écrit :

Un peu prise de tête, à tester.

Tu l'as dit !!

Ça marche du tonnerre avec les quelques cas particuliers que je rencontre ! Le seul petit hic c'est que je ne sais jamais sur quel cas je tombe parmi mes milliers de cellules !

Mais bon, avec toutes les propositions que j'ai eues, je vais pouvoir tout gérer

Un grand merci pour ta participation Eric.

J'attends un peu avant de passer en résolu, on sait jamais si ton cerveau pond une autre solution !!

A+

Bonjour,

Mais c'est quoi ta problématique exacte ?

Parce là tu es parti sur une méthode de résolution mais il y a peut-être une autre façon d'aborder le problème différemment.

C'est la première fois que je vois le besoin d'analyser des formules, que tu ne connais pas et qui plus est ne sont jamais les mêmes...

eric

eriiic a écrit :

Mais c'est quoi ta problématique exacte ?

J'avais écrit dans mon tout premier post :

vba-new a écrit :

Le but ultime de l'exercice étant de rajouter en VBA un paramètre à cette fonction à une position donnée...

Pour faire ça, je pense (à tort ?) que le seul moyen est de savoir comment extraire un à un les arguments des formules. De plus, la méthode d'extraction de ces arguments m'intéressait personnellement, par simple curiosité et pour ma propre culture !

Donc, si tu as une autre solution pour ajouter un argument à une position donnée (dans notre fameuse formule CONCATENER), je serais tout aussi curieux de savoir !

Si tu pouvais partir du contenu de la cellule pour fabriquer ta nouvelle chaine et te débarrasser de la formule ça serait beaucoup plus rapide mais je suppose que tu ne peux pas (?)

eric

Bonjour Eric

eriiic a écrit :

Si tu pouvais partir du contenu de la cellule pour fabriquer ta nouvelle chaine et te débarrasser de la formule ça serait beaucoup plus rapide mais je suppose que tu ne peux pas (?)

Merci Eric mais effectivement je ne peux pas.

La raison est que si j'utilise une autre fonction que CONCATENER (ET par exemple), ta méthode ne marchera plus.

Le CONCATENER était un exemple... Excuse si ce n'était pas assez clair !

Rechercher des sujets similaires à "extraire parametres arguments fonction vba"