Microsoft 365 Code VBA

Usine à gaz · 18 Avril 2022

Bonjour à toutes et à tous

Je n'arrive pas à faire fonctionner mon code.
Le contexte :
Condition 1
- Texte en...B5 : "Outre Mer Et excel-download"
- N° tel en.E5 : 33111111111
La condition est la suivante : si E5 <33999999999 : en B5 = "Et excel-download" ("Outre Mer " doit être supprimé)
Condition 2
- Texte en.. B5 : "Et excel-download"
- N° tel en.E5 : 262111111111 (par exemple)
La condition est la suivante : si E5 >33999999999 : en B5 = "Outre Mer Et excel-download" ("Outre Mer " doit être ajouté)
La condition 2 fonctionne bien et ne pose pas de problème

Ce n'est pas le cas de la Condition 1 et malgré mes tentatives, je n'y arrive pas !
Mes 4 codes différents ne fonctionnent pas Grrrrr !!!

VB:

Sub OutreMer1()
[e5].Select
If ActiveCell > 33999999999# Then
    ActiveCell.Offset(0, -3) = "Outre Mer " & ActiveCell.Offset(0, -3).Value
    Else
    ActiveCell.Offset(0, -3).Value = "=MID(RC[-3],10,LEN(ActiveCell.Offset(0, -3)))"
    End If
    [A5].Select
End Sub
Sub OutreMer2()
[e8].Select
If ActiveCell > 33999999999# Then
    ActiveCell.Offset(0, -3) = "Outre Mer " & ActiveCell.Offset(0, -3).Value
    Else
    ActiveCell.Offset(0, -3).Value = "=MID(ActiveCell.Offset(0, -3),11,300)"
    End If
    [A8].Select
End Sub
Sub OutreMer3()
[e11].Select
If ActiveCell > 33999999999# Then
    ActiveCell.Offset(0, -3) = "Outre Mer " & ActiveCell.Offset(0, -3).Value
    Else
    ActiveCell.Offset(0, -3).Value = "=RIGHT(RC[-3],LEN(RC[-3])-10)"
    End If
    [A11].Select
End Sub
Sub OutreMer4()
[e14].Select
If ActiveCell > 33999999999# Then
    ActiveCell.Offset(0, -3) = "Outre Mer " & ActiveCell.Offset(0, -3).Value
    Else
    ActiveCell.Offset(0, -3).Value = "=REPLACE(ActiveCell.Offset(0, -3),1,10,"""")"
    'ActiveCell.Offset(0, -3).Value = "=REPLACE(RC[-3],1,10,"""")"
    End If
    [A14].Select
End Sub

Auriez-vous le bon code pour la condition 1 ?
Je joins mlon fichier test.
Un grand merci.
Entre temps, je continue recherches et tests...
Lionel

job75 · 19 Avril 2022

Bonjour Lionel, fanch55, le forum,

ActiveCell.Offset(0, -3).Value = Mid(ActiveCell.Offset(0, -3), 11) ne va pas du tout quand on exécute 2 fois de suite la macro avec le même n° 33111111111.

Utilisez plutôt :

VB:

Sub OutreMer1()
With [B5]
    .Value = IIf(.Offset(, 3) > 33999999999#, "Outre Mer ", "") & Replace(.Value, "Outre Mer ", "")
End With
End Sub

A+

fanch55 · 18 Avril 2022

Salut Lionel,
Tu t'es coincé tout seul en te focalisant à vouloir mettre une formule dans une valeur .
Le plus simple :
ActiveCell.Offset(0, -3).Value = Mid(ActiveCell.Offset(0, -3), 11)

Usine à gaz · 18 Avril 2022

Bonjour fanch55

Merci c'est nickel,
Effectivement, il ne fallait pas me focaliser sur une formule.
Grand merci à toi !
lionel

job75 · 19 Avril 2022

Bonjour Lionel, fanch55, le forum,

ActiveCell.Offset(0, -3).Value = Mid(ActiveCell.Offset(0, -3), 11) ne va pas du tout quand on exécute 2 fois de suite la macro avec le même n° 33111111111.

Utilisez plutôt :

VB:

Sub OutreMer1()
With [B5]
    .Value = IIf(.Offset(, 3) > 33999999999#, "Outre Mer ", "") & Replace(.Value, "Outre Mer ", "")
End With
End Sub

A+

Usine à gaz · 19 Avril 2022

Bonjour Gérard
Merci et Merci et encore.
lionel

Usine à gaz · 19 Avril 2022

Re
Sub OutreMer1()
With ActiveCell.Offset(, -3)
.Value = IIf(ActiveCell > 33999999999#, "Outre Mer ", "") & Replace(.Value, "Outre Mer ", "")
End With
End Sub
Fonctionne nickel de chez nickel.
"Outre Mer " s'affiche et s'enlève à gauche dans la cellule.
On pourrait le faire à droite en bout de texte " Outre Mer" ?
Cela me laisserait la possibilité de la mettre dans la cellule de mon Prospect sans altérer le classement alphabétique.
Je cherche de mon côté,
Encore merci ...
lionel

job75 · 19 Avril 2022

Tu aurais pu le faire tout seul je pense :

VB:

Sub OutreMer1()
With [B5]
    .Value = Replace(.Value, " Outre Mer", "") & IIf(.Offset(, 3) > 33999999999#, " Outre Mer", "")
End With
End Sub

Usine à gaz · 19 Avril 2022

Encore Merci Gérard
"Tu aurais pu le faire tout seul je pense"
Pas sûr du tout lol mais merci de le penser

Microsoft 365 Code VBA

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

fanch55

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Discussions similaires