Microsoft 365 Coder en vba une formule

Usine à gaz

XLDnaute Barbatruc
Bonsoir à toutes et à tous,

Je bute sur un code que je n'arrive pas à faire.

J'ai cette formule dans ma cellule "F7":
=SI(CNUM(GAUCHE(F7;2))<>33;33&DROITE(F7;9);CNUM(DROITE(F9;3)&DROITE(F7;9)))

Je voudrais la traduire en code VBA dans mon code feuille
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("f6:f15")) Is Nothing Then
MsgBoxListeDeChoix

J'ai cette formule dans une cellule :
=SI(CNUM(GAUCHE(F7;2))<>33;33&DROITE(F7;9);CNUM(DROITE(F9;3)&DROITE(F7;9)))
comme suit :
F7 = activecell (cellule active qui n'est jamais la même),
F9 = toujours A1

Auriez-vous le bon code ?
Si besoin, je ferai un petit fichier test.
Je vous remercie,
lionel :)
 

Usine à gaz

XLDnaute Barbatruc
Re AtTheOne

"Lionnel, tu pouvais peut-être déboguer, non ?"
Evidemment que je l'ai fait mais le résultat n'est pas bon.

Je te remercie de tous les efforts que tu fais mais comme je te l'ai dit :
Ne t'embêtes pas car j'ai trouvé la solution voire #post 25,
Et c'est déjà tout bon.
:)
 

AtTheOne

XLDnaute Accro
Supporter XLD
Bonjour à toutes & à tous, bonjour @Usine à gaz :
Evidemment que je l'ai fait mais le résultat n'est pas bon.

Je te remercie de tous les efforts que tu fais mais comme je te l'ai dit :
Ne t'embêtes pas car j'ai trouvé la solution voire #post 25,
Et c'est déjà tout bon.

D'accord mais je n'aime pas rester sur un échec, quand j'ai un os à ronger, je ne le lâche pas si facilement.
Aujourd'hui j'ai retrouvé mon PC, c'est plus facile qu'avec un téléphone !😁
J'ai 3 solutions à te proposer, la première est celle du post #28 avec la parenthèse fermante (légérement déboguée quoi..) qui fonctionne pour des sélections d'une seule cellule :
Enrichi (BBcode):
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("e7:e14")) Is Nothing Then
   With R
      .Value = IIf(Left(.Offset(0, 1), 2) <> "33", _
      "33" & Right(.Offset(0, 1), 9), _
       [A1] & Right(.Offset(0, 1), 9))
   End With
End If
End Sub
Et ça fonctionne :
1649000249425.gif

La 2ème c'est la même mais pour une sélection de plusieurs cellules :
Enrichi (BBcode):
Private Sub Worksheet_SelectionChange(ByVal R As Range)
Dim C As Range
     If Not Intersect(R, Range("e7:e14")) Is Nothing Then
     If Intersect(R, [E7:E14]).Address = R.Address Then
          For Each C In R.Cells
               With C
                    .Value = IIf(Left(.Offset(0, 1), 2) <> "33", _
                                 "33" & Right(.Offset(0, 1), 9), _
                                 [A1] & Right(.Offset(0, 1), 9))
               End With
          Next
     End If
     End If
End Sub
Et ça fonctionne :
1649000440526.gif

La 3ème correspond sans doute plus à ce que tu attendais : une évaluation de la formule avec la méthode EVALUATE. avec un inconvénient toutefois elle utilise des références style A1 et pas en relatif, il faut donc créer l'adresse de la cellule de gauche (colonne F) :
Enrichi (BBcode):
Private Sub Worksheet_SelectionChange(ByVal R As Range)
Dim C As Range
  If Not Intersect(R, Range("e7:e14")) Is Nothing Then
  If Intersect(R, [E7:E14]).Address = R.Address Then
     For Each C In R.Cells
       CellF = C.Offset(0, 1).Address
       C.Value = Evaluate("if(Value(left(" & CellF & ",2))<>33,33&Right(" & CellF & ",9),A1&Right(" & CellF & ",9))")
      Next
  End If
  End If
End Sub
Et ça fonctionne aussi :
1649000708193.gif

En PJ les trois exemples
Amicalement
Alain
 

Pièces jointes

  • Coder en vba une formule 1 à 1 .xlsm
    17.7 KB · Affichages: 1
  • Coder en vba une formule sél multiple .xlsm
    18.3 KB · Affichages: 1
  • Coder en vba une formule EVALUATE .xlsm
    18.7 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
314 630
Messages
2 111 354
Membres
111 113
dernier inscrit
ADA1327