Fonction ecrire

[johnstone]

Bonjour a tous,
Felicitation pour ce forum qui m'a apporté beaucoup de solution jusqu'à aujourd'hui, mais la je colle, je ne trouve pas ce que je recherche.

Pourtant c'est tout simple (mais je ne trouve pas la fonction ou n'existe pas).
Ce que je souhaite, c'est:

Si A1=1 alors ecrire dans la case indiqué dans A2 (par exemple A2=I5) la valeur de C4.

Du coup si A1=1 et A2=I5 C4=BONJOUR alors I5=BONJOUR

J'espere avoir ete le plus clair precis, et que ce sera possible 😉
Sinon je voulais preciser que j'ai aucune base en VBA.

Cordialement

 

[job75]

Re : Fonction ecrire

Bonjour johnstone; bienvenue sur XLD,

C'est un problème intéressant, il faut du VBA.

Pas le temps ce soir, mais si vous n'avez pas de réponse je m'en occuperai demain.

A+

 

[phlaurent55]

Re : Fonction ecrire

Bonjour à tous,

avec ce code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2")) Is Nothing And [A1] = 1 Then Range(CStr([A2])) = [C4]
End Sub

à+
Philippe

 

[Magic_Doctor]

Re : Fonction ecrire

Bonjour johnstone, phlaurent55,

¡Bienvenido en este foro sobresaliente!

Pendant que j'étudiais votre problème, phlaurent55 vous a envoyé une solution.
J'en profite pour envoyer la mienne fort semblable.
Votre problème est résolu non pas par une fonction mais par une macro événementielle.
Les fonctions se trouvent dans un module dit standard, alors que les macros événementielles, elles, se trouvent dans un module de feuille.
L'événement est déclenché quand on introduit quelque chose dans la cellule "A1" et uniquement dans cette cellule.

Bonne fin d'après-midi.

 

[job75]

Re : Fonction ecrire

Bonjour johnstone, Philippe, Magic_Doctor, le forum,

Une macro un peu plus compliquée dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A2,C4]) Is Nothing Then Exit Sub
Dim v, r As Range
v = 1 'à modifier éventuellement
On Error Resume Next ' si [cible] ou r ne sont pas des Range
[cible].Clear 'RAZ
Set r = Evaluate(Mid([A2].Formula, 2))
If CStr([A1]) <> CStr(v) Or Not Intersect(r, [A1:A2,C4]) Is Nothing Then Exit Sub
r.Name = "cible" 'nom défini
r = [C4]
r.Interior.ColorIndex = 40 'mise en couleur facultative
End Sub

La cellule cible est mémorisée dans un nom défini pour pouvoir être effacée.

Fichier joint.

A+

 

[job75]

Re : Fonction ecrire

Re,

Avec Evaluate([A2].Formula) on peut entrer en A2 soit une formule de liaison soit le texte d'une référence :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A2,C4]) Is Nothing Then Exit Sub
Dim v, r As Range
v = 1 'à modifier éventuellement
On Error Resume Next ' si [cible] ou r ne sont pas des Range
[cible].Clear 'RAZ
Set r = Evaluate([A2].Formula)
If CStr([A1]) <> CStr(v) Or Not Intersect(r, [A1:A2,C4]) Is Nothing Then Exit Sub
r.Name = "cible" 'nom défini
r = [C4]
r.Interior.ColorIndex = 40 'mise en couleur facultative
End Sub

Fichier (2).

A+