Remplacer par multiples et consécutifs

Bonjour,

Je dispose d'une table de données dans mon fichier excel, comme dans l'exemple ci-joint (feuillet 2).

Dans un autre feuillet (feuillet 1), j'ai plein de formules faisant des recherchev() dans la table du feuillet 2.

Dans l'exemple ci-joint, j'ai une table de 6 lignes, et 6 formules, mais en réalité, j'ai une table de 144 lignes et des milliers de formules.

Je cherche un moyen de remplacer dans les formules la fonction recherchev() par la valeur présente dans la table (exemple : remplacer "RECHERCHEV("A+B";Feuil2!A:B;2;FAUX)" par "1"), sans avoir à faire 144 "remplacer par" successifs. Et ce uniquement dans le feuillet 1, (pas dans tous les feuillets du classeur).

Je sais que c'est possible via une macro VBA, mais je ne sais pas le faire

Merci de votre aide!

Nicole

Bonjour,

Pourquoi ne pas remplacer tout simplement par les valeurs ?

bonjour,

une proposition de solution, qui fonctionne avec le fichier exemple que tu as donné

Sub aargh()
    With Sheet1
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To dl 'on parcourt les lignes
            f = .Cells(i, 1).Formula 'f contient la formule de la ligne
            ar = Mid(f, InStr(f, "VLOOKUP")) ' on isole la fonction à remplacer dans ar (VLOOKUP = RECHERCHEV )
            ar = Left(ar, InStr(ar, ")")) 'on prend la formule qui commence à VLOOKUP et qui se termine par une )
            .Cells(i, 1).Formula = "=" & ar ' on met la formule dans la cellule
            v = .Cells(i, 1) 'on met la valeur du vlookup dans v
            .Cells(i, 1).Formula = Replace(f, ar, v) 'on remplace le vlookup par la valeur trouvée v
        Next i
    End With
End Sub
MFerrand a écrit :

Bonjour,

Pourquoi ne pas remplacer tout simplement par les valeurs ?

C'est bien mon intention : remplacer les 6 recherchev() (144 en réalité) par les valeurs correspondantes.

Je parlais de supprimer complètement les formules...

h2so4 a écrit :

bonjour,

une proposition de solution, qui fonctionne avec le fichier exemple que tu as donné

Sub aargh()
    With Sheet1
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To dl 'on parcourt les lignes
            f = .Cells(i, 1).Formula 'f contient la formule de la ligne
            ar = Mid(f, InStr(f, "VLOOKUP")) ' on isole la fonction à remplacer dans ar (VLOOKUP = RECHERCHEV )
            ar = Left(ar, InStr(ar, ")")) 'on prend la formule qui commence à VLOOKUP et qui se termine par une )
            .Cells(i, 1).Formula = "=" & ar ' on met la formule dans la cellule
            v = .Cells(i, 1) 'on met la valeur du vlookup dans v
            .Cells(i, 1).Formula = Replace(f, ar, v) 'on remplace le vlookup par la valeur trouvée v
        Next i
    End With
End Sub

Bonjour H2SO4,

alors quand je lance cette macro dans le fichier test, ça m'ouvre le débogage (erreur 424 : Objet requis), en mettant en jaune cette ligne :

dl = .Cells(Rows.Count, 1).End(xlUp).Row

Et par ailleurs, si je comprends bien le fonctionnement de ta macro, elle va opérer pour toutes les formules du feuillet, ce qui est OK pour l'exemple mais peut être problématique dans mon fichier réel car j'ai d'autres formules que je souhaite laisser intactes.

Donc peux-tu modifier le code pour que la macro se limite à la plage A1:B15 du feuillet 1 stp?

Merci


MFerrand a écrit :

Je parlais de supprimer complètement les formules...

ah, je comprends. Dans l'exemple, ce serait une solution, en effet, mais dans mon fichier réel, les formules contenant les recherchev() sont + complexes que celles de l'exemple et font appel à d'autres cellules.

Ok ! C'est toi qui voit...

En attendant h2so4 (que je salue !) essaie de remplacer Sheet1 par Feuil1

Cordialement.

Bonjour,

Bonjour MFerrand,

Sub aargh()
    For Each c In Sheets("feuil1").Range("A1:B15")
        f = c.Formula
        v = InStr(f, "VLOOKUP")
        If v > 0 Then
            ar = Mid(f, v)
            ar = Left(ar, InStr(ar, ")"))
            c.Formula = "=" & ar
            v = c
            c.Formula = Replace(f, ar, v)
        End If
    Next
End Sub
MFerrand a écrit :

Ok ! C'est toi qui voit...

En attendant h2so4 (que je salue !) essaie de remplacer Sheet1 par Feuil1

Cordialement.

yes, en mettant Feuil1, ça marche. Merci à tous les deux!


h2so4 a écrit :

Bonjour,

Bonjour MFerrand,

Sub aargh()
    For Each c In Sheets("feuil1").Range("A1:B15")
        f = c.Formula
        v = InStr(f, "VLOOKUP")
        If v > 0 Then
            ar = Mid(f, v)
            ar = Left(ar, InStr(ar, ")"))
            c.Formula = "=" & ar
            v = c
            c.Formula = Replace(f, ar, v)
        End If
    Next
End Sub

Merci bcp H2SO4 !


Hmmm, encore un souci....

Dans mon vrai fichier, ça ne fonctionne pas.

J'ai l'impression que c'est parce qu'il y a + eurs recherchev() dans la même cellule

Exemple d'une formule issue de mon vrai fichier :

=BH8*BT8*RECHERCHEV("A";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BU8*RECHERCHEV("B";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BV8*RECHERCHEV("G";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BW8*RECHERCHEV("R";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BX8*RECHERCHEV("Z";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BY8*RECHERCHEV("Y";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BZ8*RECHERCHEV("1";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CA8*RECHERCHEV("5";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CB8*RECHERCHEV("7";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CC8*RECHERCHEV("8";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CD8*RECHERCHEV("6";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CE8*RECHERCHEV("3";'Confrontation'!$Y$2:$Z$146;2;FAUX)

personne ne connait une solution qui fonctionne quand les formules contiennent plusieurs recherchev()?

A la base, je pensais à quelque chose qui simule vraiment des "remplacer par" successifs en allant piocher dans un tableau :

Remplacer le contenu de A1 par celui de B1, remplacer le contenu de A2 par celui de B2, etc...

J'aurais préalablement placé dans la colonne A et la colonne B les expressions à remplacer.

re-Bonjour,

une adaptation, attention les RECHERCHEV doivent renvoyer un résultat valide.

Sub aargh()
    For Each c In Sheets("feuil1").Range("A1:B15")
        f = c.Formula
        v = InStr(f, "VLOOKUP")
        While v > 0
            ar = Mid(f, v)
            ar = Left(ar, InStr(ar, ")"))
            c.Formula = "=" & ar
            v = c
            c.Formula = Replace(f, ar, v)
            f = c.Formula
            v = InStr(f, "VLOOKUP")
        Wend
    Next
End Sub
h2so4 a écrit :

re-Bonjour,

une adaptation, attention les RECHERCHEV doivent renvoyer un résultat valide.

Sub aargh()
    For Each c In Sheets("feuil1").Range("A1:B15")
        f = c.Formula
        v = InStr(f, "VLOOKUP")
        While v > 0
            ar = Mid(f, v)
            ar = Left(ar, InStr(ar, ")"))
            c.Formula = "=" & ar
            v = c
            c.Formula = Replace(f, ar, v)
            f = c.Formula
            v = InStr(f, "VLOOKUP")
        Wend
    Next
End Sub

Dans mon fichier, ça ouvre une erreur d'éxécution 1004 : Erreur définie par l'application ou par l'objet.

Et c'est cette ligne qui est en jaune :

c.Formula = Replace(f, ar, v)


Ca se produit dès la première cellule concernée dont la formule est du type :

=BH8*BT8*RECHERCHEV("A";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BU8*RECHERCHEV("B";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BV8*RECHERCHEV("G";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BW8*RECHERCHEV("R";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BX8*RECHERCHEV("Z";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BY8*RECHERCHEV("Y";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*BZ8*RECHERCHEV("1";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CA8*RECHERCHEV("5";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CB8*RECHERCHEV("7";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CC8*RECHERCHEV("8";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CD8*RECHERCHEV("6";'Confrontation'!$Y$2:$Z$146;2;FAUX)

+ BH8*CE8*RECHERCHEV("3";'Confrontation'!$Y$2:$Z$146;2;FAUX)

Je ne sais pas si ça peut aider, mais lorsque le message d'erreur s'ouvre, dans la cellule en question, il ne reste plus que :

=RECHERCHEV("A";'Confrontation'!$Y$2:$Z$146;2;FAUX)

suis en train de tester une autre solution.

Je posterai ici si ça fonctionne.

Et quelle est la valeur affichée dans la cellule ?

h2so4 a écrit :

Et quelle est la valeur affichée dans la cellule ?

Je ne comprends pas ta question.

Pour l'instant, je ne trouve pas de solution.

Voici un fichier test qui reprend exactement les mêmes formules que dans mon fichier : le feuillet bleu contient les cellules bleues que je souhaite modifier.

Et le feuillet "data" contient les valeurs de références.

3classeur2.xlsb (943.47 Ko)

bonsoir,

j'ai testé la macro sur ton fichier.

Je ne vois pas de problème.


nicopat a écrit :
h2so4 a écrit :

Et quelle est la valeur affichée dans la cellule ?

Je ne comprends pas ta question.

Pour l'instant, je ne trouve pas de solution.

tu dis que la macro s'arrête et que dans une certaine cellule il y a une formule, quelle est la valeur affichée dans la cellule comme résultat de cette formule ?

5classeur2.xlsb (481.96 Ko)

Bonjour H2SO4,

Ben quand je lance la macro, ça me met un message d'erreur de débogage, et c'est cette ligne là qui apparaît en jaune :

c.Formula = Replace(f, ar, v)

Cela se produit dè la première cellule traitée (en haut à gauche de la plage), dont le contenu devient alors :

=RECHERCHEV("MST vs MST";Data!$Y$2:$Z$146;2;FAUX)

Les autres cellules demeurent inchangées.


Bonjour à tous,

Il semblerait que le code ci-dessous soit une solution à mon problème en le collant dans le code du feuillet concerné :

Option Explicit

Sub test_2()
Dim xcell, t, i&, Form$, dep&, c0&, T0

  T0 = Timer
  Application.ScreenUpdating = False
  For Each xcell In Range("cf8:cq1090")
    If xcell.HasFormula Then
      c0 = 1
      Form = xcell.Formula
      Do While c0 <> 0
        dep = c0
        suivant Form, "VLOOKUP", dep, c0
      Loop
      xcell.Formula = Form
    End If
  Next xcell
  MsgBox Format(Timer - T0, "#,##0.00\ sec.")
End Sub

Sub suivant(xformul, Quoi, depuisCar&, debC&)
Dim i0&, c$, nparenthese&, finC&, valeur

  If xformul = "" Or depuisCar > Len(xformul) Then
    debC = 0
    Exit Sub
  End If

  debC = InStr(depuisCar, xformul, Quoi, vbBinaryCompare)
  If debC = 0 Then Exit Sub

  For finC = debC + Len(Quoi) To Len(xformul)
    c = Mid(xformul, finC, 1)
    Select Case c
    Case "("
      nparenthese = nparenthese + 1
    Case ")"
      nparenthese = nparenthese - 1
      If nparenthese = 0 Then Exit For
    End Select
  Next finC

  If nparenthese <> 0 Then
    debC = 0
    Exit Sub
  End If

  valeur = CStr(Evaluate(Mid(xformul, debC, finC - debC + 1)))
  valeur = Replace(valeur, ",", ".")
  xformul = Left(xformul, debC - 1) & Chr(135) & Mid(xformul, finC + 1)
  xformul = Replace(xformul, Chr(135), valeur)
End Sub

Merci beaucoup H2SO4 pour ton aide!

Rechercher des sujets similaires à "remplacer multiples consecutifs"