Microsoft 365 VBA Somme de VLOOKUP

eric72

XLDnaute Occasionnel
Bonjour à tous,
Je cherche une solution pour calculer cette opération, mais cela ne fonctionne pas du tout:

Me.TxtPrixVenteUnite = Application.WorksheetFunction.VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 9, False) / _
somme(Application.WorksheetFunction.VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 2, False); Application.WorksheetFunction.VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 3, False) _
;Application.WorksheetFunction.VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 4, False)

Quelqu'un a t il une solution pour régler mon problème?
Merci de votre dévouement toujours au top.
Eric
 

eric72

XLDnaute Occasionnel
Je n'en peux plus, ta formule fonctionne mais ne renvoie pas la bonne valeur.
Exemple trajet 1 personne prod/heure = 60
quand je saisie en quantité 60, cela devrait renvoyer: "qté" 60 / "prod" 60 * "prix vente" 33.33 = 33.33 et la formule renvoie 33.61, c'est un truc de fou mais je pense que cela vient des arrondis.
Ne te prends pas la tête, tu as déjà fait beaucoup...
Merci merci merci pour tout
Eric
 

eric72

XLDnaute Occasionnel
Il faudrait faire ça mais ca beug aussi!!!

Me.TxtPrixVenteTotal = (Me.TxtQte / Cellule_en_Cours.Range("J1").Value) * ((Sheets("Données Calcul").Range("T4") * Sheets(Prestations).Range("K3")) / 100 + Sheets("Données Calcul").Range("T4"))
mais là je m'emmêle les crayons, suis un peu paumé
 

Yeahou

XLDnaute Accro
Supporter XLD
ce code fonctionne chez moi
VB:
Private Sub TxtDesignation_Change()
'permet de faire la recherche verticale pour avoir le prix de vente unitaire de la désignation
    Dim Cellule_en_Cours As Range 'déclaration d'un objet range
    On Error Resume Next 'si erreur passe ligne suivante
    Set Cellule_en_Cours = Feuil2.Columns("A:A").Find(What:=Me.TxtDesignation, After:=Feuil2.Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 'référence la première cellule de Feuil2.Columns("A:A") égale à Me.TxtDesignation, renvoie une erreur si non trouvé
    If Cellule_en_Cours Is Nothing Then MsgBox "Référence introuvable : " & Me.TxtDesignation, vbOKOnly + vbInformation: Exit Sub 'si la cellule n'est pas trouvée message et sortie
    Me.TxtPrixAchatUnite = Cellule_en_Cours.Range("G1").Value ' prend la valeur de G1 en décalage à cellule_en_cours, comme cellule_en_cours est colonne A, la valeur renvoyée correspond colonne G, pareil que Cellule_en_cours.offset(0,6).value
    Me.TxtMarge = Cellule_en_Cours.Range("H1").Value ' prend la valeur de H1 en décalage à cellule_en_cours, comme cellule_en_cours est colonne A, la valeur renvoyée correspond colonne H, pareil que Cellule_en_cours.offset(0,7).value
    If Application.WorksheetFunction.Sum(Cellule_en_Cours.Range("B1:F1")) = 0 Then 'vérifies la somme de B1:F1 en rapport à Cellule_en_cours, en exemple si cellule_en_cours était colonne B, renverrait la somme de C1:G1
         Me.TxtPrixVenteUnite = Cellule_en_Cours.Range("G1").Value
    Else
        Me.TxtPrixVenteUnite = Cellule_en_Cours.Range("I1").Value / Application.WorksheetFunction.Sum(Cellule_en_Cours.Range("B1:F1"))
    End If
    Me.TxtPrixVenteUnite = Round(Me.TxtPrixVenteUnite.Value, 2)
    Me.TxtPrixVenteTotal = Me.TxtQte / Cellule_en_Cours.Range("J1").Value * Cellule_en_Cours.Range("I1").Value
    Me.TxtPrixVenteTotal = Round(Me.TxtPrixVenteTotal.Value, 2)
End Sub
Private Sub TxtQte_Change()
If Me.TxtQte = Empty Then Me.TxtQte = 0 Else Me.TxtQte = Me.TxtQte / 1: TxtDesignation_Change
End Sub
Sans titre.png
 
Dernière édition:

Yeahou

XLDnaute Accro
Supporter XLD
j'ai trouvé, tu refais le calcul dans la change de la textbox quantité, son calcul est faussé
modifies la comme suit (comme je t'avais dit la première fois)et ça ira
si tu ne veux pas relancer la proc, il faut externaliser cellule_en_cours pour que la change de la textbox quantité puisse l'utiliser
c'est pour cela que mon fichier fonctionnait et pas le tien
j'avais gardé If Me.TxtQte = Empty Then Me.TxtQte = 0 Else Me.TxtQte = Me.TxtQte / 1: TxtDesignation_Change
VB:
Private Sub TxtQte_Change()
If Me.TxtQte = Empty Then Me.TxtQte = 0
If Not IsNumeric(Me.TxtQte) Then Exit Sub
If Not IsNumeric(Me.TxtPrixVenteUnite) Then Exit Sub
TxtDesignation_Change
End Sub
 

eric72

XLDnaute Occasionnel
Ahhhhhhh, ouf merci beaucoup, j'ai une dernière question mais je comprendrais que j'ai assez abusé de ta bonne volonté pour aujourd'hui:
Lorsqu'on exporte la listbox dans l'onglet "prépa devis", les nombres sont en format texte, bizarre!!!
Je te remercie 1000 fois pour le boulot que tu as fait, c'est juste génial...
Bonne soirée, repose toi bien
Eric
 

Statistiques des forums

Discussions
286 624
Messages
1 877 552
Membres
160 770
dernier inscrit
pronostics.store
Haut Bas