Comment à partir un Vlookup, remplacer une valeur dans la cellule cible

Bonjour,

Essayant de trouver des solutions de gestion dans l'entreprise dans laquelle je travaille, mon but est de faire un inventaire de teintes. Pour ce faire comme je doit le tenir en fonction des dossiers qui arrive, j'ai du faire une autre page sur mon document excel pour compiler les données et savoir ce que je devais retrancher. (Je suis débutant en VBA, ca fait que 2 jours que je m'y suis mis)

Pour éviter de perdre trop de temps à le calculer moi même j'ai voulu sur cette page ou je stock toute mes données, créer une macro qui a pour but de chercher le distributeur et la quantité d'encre que l'on a en stock. (cette partie là est faite et pas de souci quand à l'execution)

Mais dans un second temps ce que j'aimerais c'est à partir de mon formulaire créer avec Vlookup pour chercher mes informations, pouvoir récupérer la valeur de la cellule prise par le Vlookup, ajouter (et plus tard laisser le choix de retrancher) la valeur mise dans ma combobox (Ajout), mais c'est cette partie là que j'ai du mal sans nommé directement la cellule ce que j'aimerais pouvoir automatiser. Auriez vous des idées pour améliorer le code ?

Voici le code et le fichier :

Private Sub btnAjout_Click()

Sheets("Inventaire encre").Range(TextBox6.Value, TextBox7.Value).Select = Range(TextBox6.Value, TextBox7.Value).Value + TextBox5.Value

End Sub

Private Sub btnFermer_Click()

Unload Me

End Sub

Private Sub btnRetrait_Click()

End Sub

Private Sub ListeEncre_Change()

End Sub

Private Sub UserForm_initialize()

With ListeEncre
.AddItem "Quadri Black"
.AddItem "Quadri cyan"
.AddItem "Quadri magenta"
.AddItem "Quadri Yellow"
.AddItem "Beige 59134"
.AddItem "Beige 59145"
.AddItem "Beige 9134"
.AddItem "Bleu 072 SL"
.AddItem "bleu 300"
.AddItem "bleu 3005"
.AddItem "Bleu 293 Modifié"
.AddItem "bleu 287"
.AddItem "Dark Blue"
.AddItem "Bleu PMS 288"
.AddItem "brun 476"
.AddItem "brun 4625"
.AddItem "brun 4975"
.AddItem "blanc couvrant"
.AddItem "Gris 411 PMS"
.AddItem "Gris 443"
.AddItem "Gris 445"
.AddItem "Gris 446"
.AddItem "Gris PMS 421"
.AddItem "CG 4"
.AddItem "Jaune 0131 Pastel"
.AddItem "Jaune 2055 PMS"
.AddItem "Jaune 9100"
.AddItem "Black 6C"
.AddItem "Orange 151"
.AddItem "Black"
.AddItem "Blue 072 Intensive"
.AddItem "Green"
.AddItem "Orange 21"
.AddItem "Process Blue"
.AddItem "Reflex Blue"
.AddItem "Rhodamine Red"
.AddItem "Rouge 32"
.AddItem "Rubine Red"
.AddItem "Vert Fluo 916 Plus Concentré et Adoucie"
.AddItem "Warm Red"
.AddItem "Yellow 12"
.AddItem "Pantone Yellow C+U"
.AddItem "Purple Pantone 1305 C+U Solide Lumière"
.AddItem "White transparent (1kg)"
.AddItem "White transparent (2,5 kg)"
.AddItem "Rose 2037"
.AddItem "Rose 211"
.AddItem "Rose 2037"
.AddItem "Rose 9285"
.AddItem "Rouge 1795"
.AddItem "Rouge 485"
.AddItem "Rouge 185"
.AddItem "Rouge 186"
.AddItem "Rouge 8780"
.AddItem "Rouge PMS 485 C+U"
.AddItem "Rouge Rhodamine 1304 SL"
.AddItem "Vert 347"
.AddItem "Vert 355"
.AddItem "Vert 2270"
.AddItem "Vert 9102"
.AddItem "Violet 269"
.AddItem "Violet milka"
.AddItem "Violet 9071 SL"
.AddItem "Med Purple"
.AddItem "bleu 285"
.AddItem "bleu 294"
.AddItem "bleu 305"
.AddItem "bleu pantone 279"
.AddItem "bleu pantone 544"
.AddItem "brun (469)"
.AddItem "héliotrope Purple"
.AddItem "Jaune 115"
.AddItem "jaune pantone 116"
.AddItem "Orange"
.AddItem "Violet 244"
.AddItem "Violet 259"
.AddItem "801"
.AddItem "804"
.AddItem "806"
.AddItem "811"
.AddItem "871"
.AddItem "872"
.AddItem "873"
.AddItem "874"
.AddItem "875"
.AddItem "876"
.AddItem "877"
.AddItem "8023"
.AddItem "8203"
.AddItem "8403"
.AddItem "8583"
.AddItem "8641"
.AddItem "8704"
.AddItem "8883"
.AddItem "8903"
.AddItem "8943"
.AddItem "8963"
.AddItem "10077"
.AddItem "10120"
.AddItem "10121"
.AddItem "10127"
.AddItem "10136"
.AddItem "10160"
.AddItem "10249"
.AddItem "10309"
.AddItem "10343"
.AddItem "10348"
.AddItem "10355"
.AddItem "10357"
.AddItem "10399"
.AddItem "802"
End With
End Sub

Private Sub ListeEncre_AfterUpdate()

On Error GoTo 1

If WorksheetFunction.CountIf(Sheets("Inventaire encre").Range("A:A"), Me.ListeEncre.Value) = 0 Then

MsgBox "Encre pas en stock", vbInformation + vbOKOnly, "Encre inexistante"

End If

If IsNumeric(Me.ListeEncre) = True Then

With Me

.TextBox2 = Application.WorksheetFunction.VLookup(CLng(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 2, 0)
.TextBox3 = Application.WorksheetFunction.VLookup(CLng(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 6, 0)
.TextBox6 = Application.WorksheetFunction.VLookup(CLng(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 7, 0)
.TextBox7 = Application.WorksheetFunction.VLookup(CLng(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 8, 0)
End With
Else

With Me

.TextBox2 = Application.WorksheetFunction.VLookup(LTrim(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 2, 0)
.TextBox3 = Application.WorksheetFunction.VLookup(LTrim(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 6, 0)
.TextBox6 = Application.WorksheetFunction.VLookup(LTrim(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 7, 0)
.TextBox7 = Application.WorksheetFunction.VLookup(LTrim(Me.ListeEncre), Sheets("Inventaire encre").Range("Tab_encre"), 8, 0)
End With
End If
1

End Sub

Bonjour,

Une première lecture de votre fichier...

Votre macro Private Sub Initialize peut devenir ceci

Private Sub UserForm_initialize()
ListeEncre.List = encre.ListObjects("Tableau145").ListColumns(1).DataBodyRange.Value
End sub

Le code suppose qu'il n'y a pas de doublons dans cette colonne

Vous pouvez aussi changer le AfterUpdate en Change. Cela permet aux textbox de s'actualiser directement au changement de couleur.
Sur ce code on pourrait aussi simplifier.

Une remarque, à votre place je n'aurais pas renommé le codename de la feuilx en ENCRE dans le l'éditeur VBA. Le mieux était de laisser FEUILx (x étant le numéro de la feuille)

edit :

Mais dans un second temps ce que j'aimerais c'est à partir de mon formulaire créer avec Vlookup pour chercher mes informations, pouvoir récupérer la valeur de la cellule prise par le Vlookup, ajouter (et plus tard laisser le choix de retrancher) la valeur mise dans ma combobox (Ajout), mais c'est cette partie là que j'ai du mal sans nommé directement la cellule ce que j'aimerais pouvoir automatiser. Auriez vous des idées pour améliorer le code ?

Vous pouvez donner un exemple car je ne vois pas de combobox Ajout
Je suppose que soit vous mettez un ajout ou soit un retrait. La textbox 5 Retrait sera donc toujours un nombre positif

Merci pour votre réponse, et notamment sur l'optimisation pour le initialize, ce sera pratique en cas d'ajout de référence de teinte.

Je viens de vérifier et autant pour moi, je n'ai pas mis de combo box pour l'ajout/retrait, il y a juste une textbox avec en dessous le bouton correspondant qui validera l'action et donc modifiera la valeur dans le tableau correspondant après avoir effectuer le calcul.

Ainsi dans mon esprit j'aurais voulu récupérer la valeur de quantité sur la textbox 3 pour après faire un calcul du genre textbox 3 +/- textbox 5/6 pour obtenir mon stock.

Navré je me suis un peu embrouiller dans les noms, mais il s'agit bien d'une textbox dans les deux cas.

J'espère avoir répondu à votre question

Je reprends,

textbox3 = qté -> Cela n'intervient pas dans la feuille
textbox4 = Ajout --> Le chiffre est toujours positif et on ajoute la valeur de la textbox à la quantité en colonne F X la quantité en textbox3
textbox5 = retrait --> Le chiffre est toujours positif et on retire la valeur de la textbox à la quantité en colonne F X la quantité en Textbox3

Juste ?

Oui c'est cela, les textbox 6/7 était un test mais normalement elle ne devrait pas être là, sinon le reste c'est exactement ça

Oui c'est cela, les textbox 6/7 était un test mais normalement elle ne devrait pas être là,

Voyez déjà les deux codes ci-dessous si cela répond à votre demande
Je regarderai ensuite pour supprimer la textbox 6
La textbox7 n'a plus de raison d'être puisque vous êtes toujours en colonne F

Private Sub btnAjout_Click()

With Sheets("Inventaire encre")
    If TextBox4 <> "" Then
        .Cells(TextBox6.Value, 6) = .Cells(TextBox6.Value, 6).Value _
            + (TextBox4.Value * TextBox3.Value)
    End If
End With
End Sub

Private Sub btnRetrait_Click()

With Sheets("Inventaire encre")
    If TextBox5 <> "" Then
        .Cells(TextBox6.Value, TextBox7.Value) = .Cells(TextBox6.Value, TextBox7.Value).Value _
            - (TextBox5.Value * TextBox3.Value)
    End If
End With
End Sub

C'est ce qu'il me fallait effectivement, même si cela ne s'actualise pas immédiatement et qu'il faut changer d'encre et revenir pour voir le changement mais c'était ce qu'il me fallait merci beaucoup. Et qu'est ce qui remplacera les textbox6-7 dans les formules .cells ?

C'est ce qu'il me fallait effectivement, même si cela ne s'actualise pas immédiatement et qu'il faut changer d'encre et revenir pour voir le changement mais c'était ce qu'il me fallait merci beaucoup.

Que voulez vous dire par "ne s'actualise pas immédiatement" ? Si vous cliquez sur ajouter ou retrait, la feuille est directement mise à jour. Ou je n'ai pas compris

Et qu'est ce qui remplacera les textbox6-7 dans les formules .cells

Je dois encore regarder ce point là

Pardon, je suis désolé de la méprise, quand je dit que ca ne s'actualise pas, c'est dans le userform, mais sinon, il y a bien une actualisation, mais je pensais que le programme, me remettrait automatiquement la nouvelle valeur dans la textbox 3 après avoir appuyer sur l'ajout/retrait. C'est juste cela

Edit :

Je finis de travailler vers 17h , je ne verrais vos réponses que lundi, donc si vous n'avez pas de réponse de ma part ne vous inquiétez pas

je suis désolé de la méprise, quand je dit que ca ne s'actualise pas, c'est dans le userform, mais sinon, il y a bien une actualisation, mais je pensais que le programme, me remettrait automatiquement la nouvelle valeur après avoir appuyer sur l'ajout/retrait.

Cela peut se faire bien sûr mais est-ce que cela a un intérêt ?

Edit : pas de souci pour Lundi

Oui, c'est pour pouvoir contrôler que cela soit fait, je ne serait pas le seul utilisateur et mes collègues me demande de faire en sorte que cela soit aussi visible sur la macro afin de pouvoir faire une vérification afin d'être sur d'avoir réaliser la macro. Comme vous je pense que cela n'est pas nécessaire en l'état, mais ils préfèrent tout contrôler et voir la modification directement dans la fenêtre qui les rassureraient sur la modification sur la page principale. En tout cas merci encore pour vos réponses

C'est inhabituel cela...
Et si on met un message disant que les données ont bien été enregistrées ?
Sinon je regarderai pour vous faire quelque chose à ce sujet. Dans ce cas, il faut éviter de cliquer deux fois sur le bouton Ajout ou retrait donc on pourrait vider les textbox 4 et 5 et mettre à jour la textbox3.

Edit : en tout cas c'est très beau fichier que vous avez réalisé !

Bonjour,

L'idée d'un message me plait bien, et justement, je pense que vider les textbox serait une bonne chose pour éviter les clique multiples, que cela ne fausse pas le stock.

Pour le fichier merci du compliment

Bonjour

Voici les 3 codes que vous remplacer par ceux ci-dessous :

1. Private Sub ListeEncre_Change

Private Sub ListeEncre_Change()
Dim Ligne As Integer

Ligne = ListeEncre.ListIndex + 1

With encre.ListObjects("Tableau145").DataBodyRange
    TextBox2 = .Item(Ligne, 2) 'Distributeur
    TextBox3 = .Item(Ligne, 6) 'quantite
End With
End Sub

2. Private Sub btnRetrait_Click

Private Sub btnRetrait_Click()
Dim Ligne As Integer

Ligne = ListeEncre.ListIndex + 1

With encre.ListObjects("Tableau145").DataBodyRange
    If TextBox5 <> "" Then
        .Item(Ligne, 6).Value = .Item(Ligne, 6).Value _
            - (TextBox5.Value * TextBox3.Value)

        MsgBox "Les données ont bien été ajoutées !"
        TextBox5 = ""
        TextBox3.Value = .Item(Ligne, 6)
    End If
End With
End Sub

3. Private Sub btnAjout_Click

Private Sub btnAjout_Click()
Dim Ligne As Integer

Ligne = ListeEncre.ListIndex + 1

With encre.ListObjects("Tableau145").DataBodyRange
    If TextBox4 <> "" Then
        .Item(Ligne, 6).Value = .Item(Ligne, 6).Value _
            + (TextBox4.Value * TextBox3.Value)

        MsgBox "Les données ont bien été ajoutées !"
        TextBox4 = ""
        TextBox3.Value = .Item(Ligne, 6).Value
    End If
End With
End Sub

Le code Initialize est toujours celui que vous ai donné précédemment

Vous pouvez supprimer les textbox6 et 7 dans votre userform. Elles ne servent plus.

Si tout ok pour vous, je vous donnerai une autre indication que vous pourriez éventuellement changer

Crdlt

J'ai remplacer les codes et j'ai une erreur 424, elle survient juste après cette étape lorsque je passe en étape par étape avec f8. Je ne comprend pas de quel objet requis il a besoin

erreur code

j'ai une erreur 424, elle survient juste après cette étape lorsque je passe en étape par étape avec f8. Je ne comprend pas de quel objet requis il a besoin

Pas d'erreur chez moi. Vous avez essayé sur votre fichier posté sur le forum ?

Edit : faite cette vérification :
- Allez dans le gestionnaire de noms et cliquez sur Tableau145 et regarder que la rubrique "Fait référence à" est bien sur cette plage --> Inventaire Encre !$A$2:$M$112

Autre chose : Dans cette macro, pourquoi vous ajoutez des points devant Textbox2 et textbox 3 ??? Le code que je vous ai posté n'en comporte pas

Pour les points, c'est une erreur en recopiant à laquelle je n'ai pas fait attention. Le tableau 145 est bien définis comme InventaireEncre!$A$2:$M$112, et j'ai bien mis vos bout de code dans mon programme. Et c'est bien après être entré dans le with qu'il y a un souci ... car je peut visualiser le formulaire rentrer la teinte mais après l'erreur survient.

Autant pour moi l'erreur viens du fait que j'ai oublier entre temps que j'avais remis comme vous me l'aviez conseillez le nom de la feuille en Feuil2 et non "encre". Du coup tout fonctionne parfaitement merci, et vous disiez avoir une autre indication de chose à modifiées, qu'elles sont-elles ?

j'avais remis comme vous me l'aviez conseillez le nom de la feuille en Feuil2 et non "encre". Du coup tout fonctionne parfaitement merci, et

Ah oui, désolé comme je ne savais pas et j'ai laissé "Encre".

vous disiez avoir une autre indication de chose à modifiées, qu'elles sont-elles ?

Oui c'est au sujet de la définition du nom Tableau145, c'est excel qui crée cela automatiquement. Si c'était pour moi, j'aurais plutôt renommé Tableau145 (pas très explicite). Un truc du genre --> "TEncre" ou T_Encre ou "Tableau_Encre"

Pour renommer,
- allez dans "Formules" --> "Gestionnaire de noms"
- Sélectionnez le nom "Tableau145" puis cliquez sur le bouton "Modifier"
- Dans la rubrique Nom changez par le nom que vous voulez.

Attention que si vous renommez, il faut corriger le nom dans les 4 codes de l'userform.

A vérifier mais je pense que vous pouvez supprimer le nom Tab_encre qui ne sert plus.

Merci encore pour votre aide et du temps que vous avez passer, maintenant il ne me reste plus qu'à optimiser mon excel pour que ce cela convienne à tous.

Rechercher des sujets similaires à "comment partir vlookup remplacer valeur cible"