Microsoft 365 VBA Somme de VLOOKUP

eric72

XLDnaute Accro
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
 
Solution
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 Accro
Pour être plus clair, je vous joins mon fichier:
Il s'agit du "USFPREPADEVIS", le problème est que lorsque je saisi dans "Désignation", j'aimerais qu'il tienne compte de la prod/heure dans mon onglet "Prestations" la production horaire pour que, quand je saisi une quantité il mette à jour le prix de vente total,
Exemple : Trajet 1 personne, prod/heure 60kms, si je saisi en qté 120, il calcule 120/60*33.33 =66.66
J'espère être assez clair...
Eric
 

Pièces jointes

  • test download.xlsm
    530.1 KB · Affichages: 17
Bonjour eric72, le forum

essayes cela, pas testé sans fichier

Cordialement, @+
VB:
With Application.WorksheetFunction
    Me.TxtPrixVenteUnite = .VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 9, False) / _
        (.VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 2, False) + _
        .VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 3, False) + _
        .VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 4, False))
End With
 
sinon autrement
Code:
    Dim Cellule_en_cours As Range
    On Error Resume Next
    Set Cellule_en_cours = Feuil2.Columns("A:A").Find(What:=Me.TxtDesignation, After:=Feuil2.Range("A1"), LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    With Cellule_en_cours
        Me.TxtPrixVenteUnite = .Offset(0, 8).Value / (.Offset(0, 1).Value + .Offset(0, 2).Value + .Offset(0, 3).Value)
    End With
 
Dernière édition:
j'ai vu que tu avais ajouté un fichier, par contre, il devrait être anonymisé.
j'ai regardé ton fichier mais je ne comprends pas plus, l'énoncé du post 2 ne correspond pas à celui du post 1. je ne comprends pas ce que tu cherches à faire ni ce que je dois coder, les formules déjà implémentées ne me renseignent pas plus.
Tu veux la quantité entrée divisée par la somme des colonnes B à G pour la référence multipliée par la colonne I pour la référence ?
 

eric72

XLDnaute Accro
En fait j'aimerais :
La quantité divisée par somme colonnes B à F * I
Cela permet de connaitre le prix en tenant compte de la productivité, et quand la somme B à F =0, il prend directement La quantité * colonne G (coût unitaire).
J'espère être clair!!!
Merci
Eric
 
Re,

modifies tes 2 sub comme suit ! la deuxième pour recalculer quand tu modifies la quantité
il te reste à revoir ton prix de vente total, je ne pense pas que ta formule soit bonne

Bien cordialement, @+

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
    On Error Resume Next
    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)
    If Cellule_en_Cours Is Nothing Then MsgBox "Référence introuvable : " & Me.TxtDesignation, vbOKOnly + vbInformation: Exit Sub
    On Error GoTo 1
    Me.TxtPrixAchatUnite = Cellule_en_Cours.Range("G1").Value
    Me.TxtMarge = Cellule_en_Cours.Range("H1").Value
    If Application.WorksheetFunction.Sum(Cellule_en_Cours.Range("B1:F1")) = 0 Then
         Me.TxtPrixVenteUnite = Me.TxtQte * Cellule_en_Cours.Range("G1").Value
    Else
        Me.TxtPrixVenteUnite = Me.TxtQte / Application.WorksheetFunction.Sum(Cellule_en_Cours.Range("B1:F1")) * Cellule_en_Cours.Range("I1").Value
    End If
     Me.TxtPrixVenteUnite = Round(Me.TxtPrixVenteUnite.Value, 2)
1
    Me.TxtPrixVenteTotal = CDec(Me.TxtQte) * CDec(Me.TxtPrixVenteUnite)
    Me.TxtPrixVenteTotal = Round(Me.TxtPrixVenteTotal.Value, 2)

End Sub
Private Sub TxtQte_Change()
If Me.TxtQte = Empty Then Me.TxtQte = 0 Else TxtDesignation_Change
End Sub
 
Dernière édition:

eric72

XLDnaute Accro
Les résultats ne sont pas cohérents!!!
je crois avoir trouvé une idée, dans mon tableau "Prestations", j'ai ajouté une colonne TOTAL (B:F), qui renvoie 1 si la somme est 0, du coup cela résoud mes problèmes mais je garde ton idée de:

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)
If Cellule_en_Cours Is Nothing Then MsgBox "Référence introuvable : " & Me.TxtDesignation, vbOKOnly + vbInformation: Exit Sub

qui facilite l'encodage, c'est top (même si je ne vois que du petit chinois dans ce code), je vais bosser dessus.
Merci 1000 fois pour ton dévouement et tes compétences.
Eric
 
voila un peu de traduction
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
    On Error GoTo 1
    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 = Me.TxtQte * Cellule_en_Cours.Range("G1").Value
    Else
        Me.TxtPrixVenteUnite = Me.TxtQte / Application.WorksheetFunction.Sum(Cellule_en_Cours.Range("B1:F1")) * Cellule_en_Cours.Range("I1").Value
    End If
     Me.TxtPrixVenteUnite = Round(Me.TxtPrixVenteUnite.Value, 2)
1
    Me.TxtPrixVenteTotal = CDec(Me.TxtQte) * CDec(Me.TxtPrixVenteUnite)
    Me.TxtPrixVenteTotal = Round(Me.TxtPrixVenteTotal.Value, 2)

End Sub
 

eric72

XLDnaute Accro
Il me reste un souci à résoudre, c'est mon prix de vente total qui doit être l'équivalent de ça :
Me.TxtPrixVenteTotal = (Me.TxtQte) / Application.WorksheetFunction.VLookup(Me.TxtDesignation, Feuil2.Range("a:j"), 10, False) _
* Application.WorksheetFunction.VLookup(Me.TxtDesignation, Feuil2.Range("a:i"), 9, False)

Me.TxtPrixVenteTotal = Round(Me.TxtPrixVenteTotal.Value, 2)
Mais ça ne marche pas
Désolé de te déranger encore une fois
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 897
Membres
101 833
dernier inscrit
sandra25