Microsoft 365 VBA Somme de VLOOKUP

[eric72]

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]

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

 

[Bernard_XLD]

Bonjour eric72, le forum

essayes cela, pas testé sans fichier

Cordialement, @+

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

 

[Bernard_XLD]

sinon autrement

    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

 

[eric72]

Merci pour votre réponse, mais si je teste dans mon userform cela ne marche pas, je n'ai plus aucun prix
Si vous pouviez modifier mon fichier ca serait top!!!
Sans vouloir abuser.
Merci encore
Eric

 

[Bernard_XLD]

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]

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

 

[Bernard_XLD]

re

 

[eric72]

Il est bien anonymisé, les données et noms ne correspondant à rien, pas d'inquiétude
Merci

 

[Bernard_XLD]

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, @+

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

 

[eric72]

Alors, il faut que je modifie car dans la prix de vente UNITE, la valeur est celle du prix de vente TOTAL, mais l'idée est top, je regarde cela en détail et te redis.
Merci pour le temps alloué à ma cause.

 

[eric72]

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

 

[Bernard_XLD]

voila un peu de traduction

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]

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

 

[eric72]

car cette formule là arrondit et cela crée des écarts tels 33.61 au lieu 33.33 par exemple

Me.TxtPrixVenteTotal = CDec(Me.TxtQte) * CDec(Me.TxtPrixVenteUnite)