Associer deux valeurs par VBA

Bonjour à tous et bon dimanche,

Avec le code ci-dessous qui ne fonctionne plus, je voudrai "CONCATENER" la valeur saisie dans la cellule B et la valeur de la cellule F1 si en cellule C le code "ACHAT" et saisie.

Dans le cas contraire si le code saisie est <>"ACHAT" on assemble toujours la cellule B mais avec la cellule H1

La méthode doit se répéter sur chaque ligne saisie et s'actualiser à chaque modification de code ou de saisie.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Private Sub Worksheet_Change(ByVal Target As Range)   If Target.Count = 1 And Target.Column <= 2 Then Application.EnableEvents = False If UCase(Target.Value) = "ACHAT" Then Range("D" & Target.Row).Value = Range("F1").Value & Range("B" & Target.Row).Value Else Range("D" & Target.Row).ClearContents End If Application.EnableEvents = True End If End Sub

---

Merci pour votre aide. ;)

Bonjour,

Ta condition fonctionne que si colonnes A ou B de modfiié.

Code:

---

If Target.Count = 1 And Target.Column <= 2

---

pour tester la colonne C

Code:

---

If Target.Count = 1 And Target.Column = 3

---

Merci,

ça ne fonctionne pas je fais des essais et rien ne va.

Si je saisie ACHAT en D en E rien ne s'écrit.
Je ne suis pas sortie de l'auberge pour lui faire associer la cellule B et H1 dans le cas ou le code serait différent de "ACHAT".

Encore merci.:?

Il faudrait savoir ce que tu veux

1er post

Citation:

---

si en cellule C le code "ACHAT" et saisie

---

2eme post

Citation:

---

Si je saisie ACHAT en D en E rien ne s'écrit.

---

Pour la première partie du code c'est bon j'ai compris, maintenant reste à trouver la seconde, "pour concatener avec H1 si le code est différent de "ACHAT".

Merci.

Tu as réussi a faire la concaténation si = Achat.
C'est le même principe

Code:

---

1 2 3 4 5

If UCase(Target.Value) = "ACHAT" Then Range("D" & Target.Row).Value = Range("F1").Value & Range("B" & Target.Row).Value Else Range("D" & Target.Row).value=Range("B" & Target.Row).Value & Range("H1").Value End If

---

Je dois passer à coté de quelque chose, ça fonctionne mais c'est pas le top lorsque je change "ACHAT" par exemple la fonction ne travaille plus.

Le code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Private Sub Worksheet_Change(ByVal Target As Range)   If Target.Count = 1 And Target.Column <= 3 Then Application.EnableEvents = False If UCase(Range("B" & Target.Row).Value) = "ACHAT" Then Range("D" & Target.Row).Value = Range("F1").Value & Range("A" & Target.Row).Value Range("E" & Target.Row).Value = Range("C" & Target.Row).Value Else Range("D" & Target.Row).ClearContents Range("E" & Target.Row).ClearContents   End If   If UCase(Range("B" & Target.Row).Value) = "VENTE" Then Range("D" & Target.Row).Value = Range("H1").Value & Range("A" & Target.Row).Value Range("E" & Target.Row).Value = ""   Else Range("D" & Target.Row).ClearContents Range("E" & Target.Row).ClearContents End If End If Application.EnableEvents = True End Sub

---

Merci pour ton aide :D

J'y suis peut-être arrivé, mais il y a un truck que je comprend pas, si je colle le code dans un classeur vierge il tourne à 200 % même avec + de 200000 lignes, si je le colle dans un classeur ayant des données il ne fonctionne pas et en plus Excel devient très lent, le sablier tourne quelque secondes.

Je vais poster une nouvelle question pour avoir si possible une explication.


le code

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

Private Sub Worksheet_Change(ByVal Target As Range)   If Target.Count = 1 And Target.Column <= 4 Then Application.EnableEvents = False If UCase(Range("D" & Target.Row).Value) = "ACHAT" Then Range("E" & Target.Row).Value = Range("E4").Value & Range("B" & Target.Row).Value Range("F" & Target.Row).Value = Range("C" & Target.Row).Value   Else Range("E" & Target.Row).ClearContents Range("F" & Target.Row).ClearContents   If UCase(Range("D" & Target.Row).Value) <> "ACHAT" Then Range("E" & Target.Row).Value = Range("F4").Value & Range("B" & Target.Row).Value Range("F" & Target.Row).Value = Range("G4").Value   Else Range("E" & Target.Row).ClearContents Range("F" & Target.Row).ClearContents   End If   End If Application.EnableEvents = True End If   End Sub

---

Bonne soirée ;)

L'une efface l'autre

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Private Sub Worksheet_Change(ByVal Target As Range)   If Target.Count = 1 And Target.Column <= 3 Then Application.EnableEvents = False If UCase(Range("B" & Target.Row).Value) = "ACHAT" Then Range("D" & Target.Row).Value = Range("F1").Value & Range("A" & Target.Row).Value Range("E" & Target.Row).Value = Range("C" & Target.Row).Value ElseIf UCase(Range("B" & Target.Row).Value) = "VENTE" Then Range("D" & Target.Row).Value = Range("H1").Value & Range("A" & Target.Row).Value Range("E" & Target.Row).ClearContents Else Range("D" & Target.Row & ":E" & Target.Row).ClearContents End If Application.EnableEvents = True End If End Sub

---

Merci Mercatog,

Serait-il possible lorsque je saisie le code "VENTE" que le curseur sélectionne automatique sur la même ligne la colonne "F" pour y saisir une valeur ?

Votre code tourne très bien, mais si je le colle dans un classeur ayant des données là ou je voudrai travailler avec ce code excel travaille très lentement le sablier tourne quelques secondes, y aurait-il une solution ?

Par contre avec tous les mêmes paramètres dans un nouveau classeur pas de problème même avec beaucoup de données qui sont saisies après le collage du code.

Merci à vous et bonne soirée. :ccool:

Si tu as des calculs dans ta feuille, essaie de désactiver le calcul automatique

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Private Sub Worksheet_Change(ByVal Target As Range)   Application.Calculation = xlCalculationManual If Target.Count = 1 And Target.Column <= 3 Then Application.EnableEvents = False If UCase(Range("B" & Target.Row).Value) = "ACHAT" Then Range("D" & Target.Row).Value = Range("F1").Value & Range("A" & Target.Row).Value Range("E" & Target.Row).Value = Range("C" & Target.Row).Value ElseIf UCase(Range("B" & Target.Row).Value) = "VENTE" Then Range("D" & Target.Row).Value = Range("H1").Value & Range("A" & Target.Row).Value Range("E" & Target.Row).ClearContents Range("F" & Target.Row).Select Else Range("D" & Target.Row & ":E" & Target.Row).ClearContents End If Application.EnableEvents = True End If Application.Calculation = xlCalculationAutomatic End Sub

---

Grand merci à vous.

Très bien !

Bonne soirée
@+

:ccool: