Aide pour un macro

Bonjour,

n'ayant qu'un niveau très bas en code VBA je me permet de solliciter votre aide car je suis dans une impasse

il y a 3 ans j'ai fait une demande pour automatiser un calcule sur une feuille qui a été résolu mais la j'aimerais approfondir l'automatisation qui me ferais gagner un peux de temps

voici le lien du document concerner :

il y a l'automatisation qui a pour fonction que si vous entré le nombre de client et que vous double clic dans les cellules vide au niveau des garnitures de la même colonne du client il fait le calcule automatiquement

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column < 3 Or Target.Row < 14 Then Exit Sub
    Cancel = True
    If Not IsNumeric(Cells(Target.Column, 11)) Or Not IsNumeric(Cells(2, Target.Row)) Then Exit Sub
    If Cells(9, Target.Column) < 1 Or Cells(Target.Row, 2) <= 0 Then Exit Sub
    If Target = "" Then Target.Formula = "=" & Cells(9, Target.Column).Address(False, False) & "*" & Cells(Target.Row, 2).Address(False, False) Else Target.ClearContents
End Sub

pour la suite, l'idée est temps que si ma formule et "4F Anniversaire" (C5) il ajoutera automatiquement les poids des garnitures qui son définie pour cette formule

Ex:
RILLETTES PORC (C14)
BOLOGNAISE (C21)
CAMEMBERT (C34)
CARAMEL (C38)

pouvez-vous m'aidez

cordialement

Bonjour,

Je n'ai sans doute pas tout compris. Si vous souhaitez associer une liste d'ingrédients à une formule, il vous faut créer une table des formules et lorsque vous choisirez une formule en C5, les quantités apparaitront en colonne B au regard des ingrédients composant la formule. Cela peut se faire avec une combinaison des fonctions Index, Equivalent.

Bonjour Magouel,

Après plusieurs lectures de votre demande je commence à comprendre votre besoin. Si j'ai bien compris selon la formule entrée en C5 Il faudrait que les calculs s'effectuent automatiquement pour les garnitures associées à chaque formule. Pouvez-vous définir les formules avec les garnitures associées afin que l'on puisse proposer une solution? S'il n'y a pas ces informations il me semble difficile d'avancer. Vous pouvez les écrire à côté du tableau ou sur une autre feuille. A partir de là, les formules pourront être choisies dans une liste déroulante et le calcul s'effectuera.

Bonjour,

Pardonner moi pour mon explication un peut vague pour vous.

Commençons par le début j'ai une formule qui se nomme "4F Anniversaire" donc il et pas la possible dans changer les garnitures qui son associer dans l'exemple :

4F Anniversaire

=> RILLETTES PORC (En C14)
=> BOLOGNAISE (En C21)
=> CAMEMBERT (En C34)
=> CARAMEL (En C38)

Voici une image représentant le résulta attendue !

capture d ecran 2022 05 15 085050

Dans celui-ci j'ai ajouter la formule "4F Anniversaire" dans la cellule C5 et je voudrais qui calcule automatiquement les garnitures par default de cette formule uniquement (le calcule par ex pour la "rillette de porc" donc le résultat et en C14 c'est C11*B14)

Peut être que vous allez me demande pourquoi uniquement cette formule par se que il y a d'autre formule que l'on peux modifier les choix de garnitures comme 5F et 8 Garnitures au choix.

Il c'est mal expliquer dite le moi et j'essayerais de faire mieux

Cordialement

Bonjour,

J'ai fait un essai voulez-vous tester?

Désolé ça ne fonctionne plus.

Re

Ca y est c'est réparé, je m'étais trompé d'une lettre. Mais attention il faut bien écrire 4F Anniversaire avec F et A en majuscule.

Super c'est ça que je voulais

Merci fcyspm30

Juste petit demande c'est quoi que l'on peut mettre dans le code pour actualiser si le nombre de personne change car on doit remettre 4F Anniversaire pour actualiser

cordialement

re

Jai modifié le code et mis une formule pour le calcul total des personnes. Ainsi si vous modifier le nombre d'adulte ou d'enfant ça rectifie le calcul.

Si vous préférez sans formule on peut rectifier le code. Mais je ne pourrai pas le faire aujourd'hui. Un autre membre peut aussi le rectifier. Aucun soucis.

Un grand merci a vous !

Vous avez résolu mon problème.

Bonne journée a vous

Bonjour

Je me permet de revenir sur le code

j'ai ajouter le code que vous m'avez fait sur un nouveau doc plus travailler avec un code déjà existant le soucis et que il affiche un message d'erreur qui ce traduit par un problème de doublon avec

worksheet_change(ByVal target As Range)

le truc c'est que je souhaite ajouter le code suivant :

Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Range("C4:C4,C10:O11")) Is Nothing Then
col = target.Column

    If Cells(4, col) = "4F 4G" Then
        Cells(15, col) = Cells(12, col) * Cells(15, 2)
        Cells(33, col) = Cells(12, col) * Cells(33, 2)
        Cells(51, col) = Cells(12, col) * Cells(51, 2)
        Cells(58, col) = Cells(12, col) * Cells(58, 2)
     Else: Exit Sub
        End If
    End If
End Sub

a celui ci :

Private Sub worksheet_change(ByVal target As Range)
    If Not Intersect(target, Range("C4:Q4,C10:Q10")) Is Nothing Then
        Set ws = Sheets("Grammage")
        trouve = False
        For col = 1 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
            If UCase(ws.Cells(1, col)) = UCase(Cells(4, target.Column)) Then
                trouve = True
                Exit For
            End If
        Next col
        If Not trouve Then
            MsgBox "La formule " & Cells(4, target.Column) & " non trouvée dans la feuille grammages"
            Exit Sub
        End If
        trouve = False
        For i = 15 To Cells(Rows.Count, 1).End(xlUp).Row
        If UCase(Left(Cells(i, 1), 5)) = "TOTAL" Then Exit Sub
            If Cells(i, target.Column) <> "" And Cells(i, 1) <> "" Then
                For ligne = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
                    If UCase(ws.Cells(ligne, 1)) = UCase(Cells(i, 1)) Then
                        trouve = True
                        Exit For
                    End If
                Next ligne
                If Not trouve Then
                    MsgBox "La garniture " & Cells(target.Row, 1) & " non trouvée dans la feuille grammages"
                    Exit Sub
                End If
                Cells(i, target.Column) = Cells(12, target.Column) * ws.Cells(ligne, col)
            End If
        Next i
        End If
    End If
End Sub

j'ai essayer plusieurs manipulations mais sans succès en trotte ça :

Private Sub worksheet_change(ByVal target As Range)
    If Not Intersect(target, Range("C4:Q4,C10:Q10")) Is Nothing Then
        Set ws = Sheets("Grammage")
        trouve = False
        For col = 1 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
            If UCase(ws.Cells(1, col)) = UCase(Cells(4, target.Column)) Then
                trouve = True
                Exit For
            End If
        Next col
        If Not trouve Then
            MsgBox "La formule " & Cells(4, target.Column) & " non trouvée dans la feuille grammages"
            Exit Sub
        End If
        trouve = False
        For i = 15 To Cells(Rows.Count, 1).End(xlUp).Row
        If UCase(Left(Cells(i, 1), 5)) = "TOTAL" Then Exit Sub
            If Cells(i, target.Column) <> "" And Cells(i, 1) <> "" Then
                For ligne = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
                    If UCase(ws.Cells(ligne, 1)) = UCase(Cells(i, 1)) Then
                        trouve = True
                        Exit For
                    End If
                Next ligne
                If Not trouve Then
                    MsgBox "La garniture " & Cells(target.Row, 1) & " non trouvée dans la feuille grammages"
                    Exit Sub
                End If
                Cells(i, target.Column) = Cells(12, target.Column) * ws.Cells(ligne, col)
            End If
        Next i
        If Not Intersect(target, Range("C4:C4,C10:O11")) Is Nothing Then
col = target.Column

    If Cells(4, col) = "4F 4G" Then
        Cells(15, col) = Cells(12, col) * Cells(15, 2)
        Cells(33, col) = Cells(12, col) * Cells(33, 2)
        Cells(51, col) = Cells(12, col) * Cells(51, 2)
        Cells(58, col) = Cells(12, col) * Cells(58, 2)
     Else: Exit Sub
        End If
    End If
End Sub

mais il me marque une erreur de compilation: Bloc If sans End If

j'avoue que je suis perdu !

pouvez vous m'explique mon erreur ?

Cordialement

Rechercher des sujets similaires à "aide macro"