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 SubMFerrand 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 SubMFerrand 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 Subh2so4 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.
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 ?
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 SubMerci beaucoup H2SO4 pour ton aide!