Details d une cellule

Le
titi
Bonjour

je souhaite avoir le detail d une cellule on m a deja donné la macro
suivante :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("e:e")) Is Nothing Then
Target.Offset(0, 1).Value = "'" & Target.Formula
End If
End Sub
Qui marche tres bien lorsqu on tape directement la formule

Mais maintenant j ai des formules du type ¡*B2

et je souhaite que ca ecrive '=2*3 et non '¡*B2

comment faire?

merci d avance


Titi
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Carim
Le #5339911
Bonjour,

Juste une première étape test ...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel1 As String
Dim cel2 As String
If Not Intersect(Target, Range("e:e")) Is Nothing Then
Target.Offset(0, 1).Value = "'" & Target.Formula
'Extraction des Strings ... à affiner
cel1 = Mid(Target.Offset(0, 1), 2, 2)
cel2 = Mid(Target.Offset(0, 1), 5, 2)
'Expliciter la Formule
Target.Offset(0, 2).Value = "'" &
Application.WorksheetFunction.Substitute _
(Application.WorksheetFunction.Substitute(Target.Offset(0, 1),
cel1, Range(cel1).Value) _
, cel2, Range(cel2).Value)
End If
End Sub

A+
titi
Le #5339841
bonjour

heu non ca marche pas j ai l erreur 1004 la methode "range" de l'objet
"_Worksheet" a échoué

si tu as des compléments a faire je suis preneur

a+
th



"Carim" :
Bonjour,

Juste une première étape test ...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel1 As String
Dim cel2 As String
If Not Intersect(Target, Range("e:e")) Is Nothing Then
Target.Offset(0, 1).Value = "'" & Target.Formula
'Extraction des Strings ... à affiner
cel1 = Mid(Target.Offset(0, 1), 2, 2)
cel2 = Mid(Target.Offset(0, 1), 5, 2)
'Expliciter la Formule
Target.Offset(0, 2).Value = "'" &
Application.WorksheetFunction.Substitute _
(Application.WorksheetFunction.Substitute(Target.Offset(0, 1),
cel1, Range(cel1).Value) _
, cel2, Range(cel2).Value)
End If
End Sub

A+


Carim
Le #5339831
Bonjour,

Essayes avec dans ta colonne E:
¡*A2
...

A +
Carim
Le #5339791
Re ...

N'est valable que pour deux éléments dans la formule ...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel1 As String
Dim cel2 As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Const Oper As String = "[*+-/]"
If Not Intersect(Target, Range("e:e")) Is Nothing Then
Target.Offset(0, 1).Value = "'" & Target.Formula
'Extraction des Strings valable pour 2 éléments dans la formule
j = Len(Target.Offset(0, 1))
For k = 1 To j
If Mid$(Target.Offset(0, 1).Value, k, 1) Like Oper Then
i = k
Exit For
End If
Next k
cel1 = Mid(Target.Offset(0, 1), 2, i - 2)
cel2 = Mid(Target.Offset(0, 1), i + 1, j - i)

Target.Offset(0, 2).Value = "'" &
Application.WorksheetFunction.Substitute _
(Application.WorksheetFunction.Substitute(Target.Offset(0, 1), cel1, _
Range(cel1).Value), cel2, Range(cel2).Value)
End If
End Sub


A +
titi
Le #5338331
bonjour

oui merci cela fonctionne bien !
merci encore !

A bientot

A+
Th


"Carim" :
Re ...

N'est valable que pour deux éléments dans la formule ...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel1 As String
Dim cel2 As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Const Oper As String = "[*+-/]"
If Not Intersect(Target, Range("e:e")) Is Nothing Then
Target.Offset(0, 1).Value = "'" & Target.Formula
'Extraction des Strings valable pour 2 éléments dans la formule
j = Len(Target.Offset(0, 1))
For k = 1 To j
If Mid$(Target.Offset(0, 1).Value, k, 1) Like Oper Then
i = k
Exit For
End If
Next k
cel1 = Mid(Target.Offset(0, 1), 2, i - 2)
cel2 = Mid(Target.Offset(0, 1), i + 1, j - i)

Target.Offset(0, 2).Value = "'" &
Application.WorksheetFunction.Substitute _
(Application.WorksheetFunction.Substitute(Target.Offset(0, 1), cel1, _
Range(cel1).Value), cel2, Range(cel2).Value)
End If
End Sub


A +


Publicité
Poster une réponse
Anonyme