Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Details d une cellule

5 réponses
Avatar
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 =A1*B2

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

comment faire?

merci d avance


Titi

5 réponses

Avatar
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+
Avatar
titi
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" a écrit dans le message de groupe de discussion
:
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+


Avatar
Carim
Bonjour,

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

A +
Avatar
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 +
Avatar
titi
bonjour

oui merci cela fonctionne bien !
merci encore !

A bientot

A+
Th


"Carim" a écrit dans le message de groupe de discussion
:
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 +