Erreur introuvable

Question

Je me permets de vous solliciter car cela fait plusieurs heures que je cherche et je ne parviens pas à trouver ce qui bloque avec mon code. Contexte : je veux créer un fichier pour mon boulot qui me permette de trouver le prix d'articles (en l’occurrence cylindre ou clé) en fonction de certaines informations saisie par l'utilisateur sur une feuille Excel. Problème : quand mon code s'exécute (à chaque modification de ma feuille), il tourne sans s'arrêter et plante mon fichier. Voici mon code (onglet "Find a price") : Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 'Let's calculate these prices :) 'But first, let's go for some explanations of my code : '*** Named cells *** ' 'I named all of the user cells to allow me to use the name in my vba code. 'Okay but why? '=&gt; because if I decide to change the design of my user form sheet, I wouldn't have to update the cells adress in my code 'Indeed if I use named cells, I can change their adress without have to update the code! ' 'All the cells in the sheet "find a price" are like "fp_XXX" 'All the cells in the sheet "Make a quote" are like "mq_XXX" 'All the cells in the sheet "Source data" are like "sd_XXX" ' '"c" will always means column and "r" row. '*** Structure of this code *** ' 'First, I will calculate all the different elements (and potential added value) which constitute the price of the cylinders/keys 'And then, I will finally calculate these prices 'Base price of the cylinder Dim base_cyl_price As Currency 'Each cylinder has a base price depending on which profile and which cylinder type it is base_cyl_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_cyl_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_cyl_type"), Worksheets("Src_data").Range("sd_cyl_types"), 0)) 'We will add in the final formula the value of the potential extensions and other added values 'Extension price Dim extension_price As Currency Dim extension_nbr As Byte 'We will determine how many extensions there are extension_nbr = Application.VLookup((Worksheets("Find a price").Range("fp_ins_length") &amp; Worksheets("Find a price").Range("fp_out_length")), Worksheets("Extensions").Range("tble_extensions"), 2, False) 'And then get the price of all these potential extensions If extension_nbr &lt;= 10 Then extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_1") Else extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_2") End If 'Base price of the key Dim base_key_price As Currency 'If the client wants a supplementary key with a cylinder, no matter if the plan is 6 months older or no, in the other cases, we first check this point If Worksheets("Find a price").Range("fp_key_type") = "Supplementary key with cylinder" Then base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), 1) Else If Worksheets("Find a price").Range("fp_ext_6_yn") = "No" Then base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_key_type"), Worksheets("Src_data").Range("sd_key_types"), 0)) Else base_key_price = Worksheets("Src_data").Range("sd_key_price_6") End If End If 'Discount rate Dim discount_rate As Variant 'We just take the rate input by the user discount_rate = Worksheets("Find a price").Range("fp_discount_rate") 'Potential added value for the pins Dim adval_pin As Currency 'We just add the potential added value if the client wants a 6 or 7 pins system If Worksheets("Find a price").Range("fp_pin") = 6 Then adval_pin = Worksheets("Src_data").Range("sd_adval_6pins") Else If Worksheets("Find a price").Range("fp_pin") = 7 Then adval_pin = Worksheets("Src_data").Range("sd_adval_7pins") Else adval_pin = 0 End If End If 'Potential added value for the system Dim adval_system As Currency 'We just add the added value for HS systems or GHS ones If Worksheets("Find a price").Range("fp_system") = "HS" Then adval_system = Worksheets("Src_data").Range("sd_adval_HS") Else If Worksheets("Find a price").Range("fp_system") = "GHS" Then adval_system = Worksheets("Src_data").Range("sd_adval_GHS") Else adval_system = 0 End If End If 'Potential added value if keyplan extension Dim adval_not_init As Currency Dim adval_6months As Currency 'We add the FHZ if the client is not the initiator of the keyplan (22% added-value) If Worksheets("Find a price").Range("fp_ext_init_yn") = "No" Then adval_not_init = Worksheets("Src_data").Range("sd_adval_not_init") Else adval_not_init = 0 End If 'We add the old system added-value of 7.98€ if the keyplan is 6 months old or more If Worksheets("Find a price").Range("fp_ext_6_yn") = "Yes" Then adval_6months = Worksheets("Src_data").Range("sd_adval_6months") Else adval_6months = 0 End If 'Potential added value for the finishes Dim adval_finishes As Currency 'To do... 'Potential added value for the knob Dim adval_knob As Currency 'To do... 'Let's now calculate the price of the cylinder :) Dim cylinder_price As Currency 'This is the final formula to calculate the cylinder price, we will just sum up all the things we previously calculated above ;) cylinder_price = (base_cyl_price + extension_price + adval_pin + adval_system + adval_6months) * (1 + adval_not_init) * (1 - discount_rate) Worksheets("Find a price").Range("fp_cyl_price") = cylinder_price 'And let's now calculate the price of the key :) Dim key_price As Currency 'And this is the same for the keys (in more easy) key_price = base_key_price * (1 + adval_not_init) * (1 - discount_rate) Worksheets("Find a price").Range("fp_key_price") = key_price End Sub Ainsi que mon fichier (rien n'est confidentiel) : Si quelqu'un trouve une solution.. Je prends! Vip4rk...

Pedro22 · Answer

Quelques conseils pour faciliter la lecture d'un code, et identifier plus facilement les erreurs : Pas de saut de lignes à tout va Pas des tartines de commentaires : commenter c'est bien, mais autant aller à l'essentiel Eviter d'alourdir le code avec des références à rallonge et répétées : on déclare les feuilles avec des noms courts et compréhensibles, et/ou on utilise With Objet ... End With (voir exemple ci dessous) With Sheets("Nom Feuille") .Range("A1") = "Bonjour" .Range("B1") = "C'est plus facile à lire !" End With - On groupe toutes les déclarations de variable en début de macro, jamais en cours d'utilisation ! Un fois qu'on y verra plus clair, on pourra s'attaquer au cœur de ton problème.....

h2so4 · Answer

Utilise application.enableevents=false et true au debut et à la fin de ta macro événementielle. ta macro s'exécute quand une cellule de ta feuille est modifiée. or tu modifies (enfin je pense), des cellules de ta feuilles dans ta macro, tu rentres donc dans une boucle sans fin, qui fait planter excel...

Pedro22 · Answer

Ca évolue dans le bon sens ! J'ai repris ton code pour modifier certains éléments (à tester) : Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim discount_rate As Variant Dim base_cyl_price As Currency, extension_price As Currency, base_key_price As Currency, adval_pin As Currency, adval_system As Currency, adval_not_init As Currency, adval_6months As Currency Dim adval_finishes As Currency, adval_knob As Currency, cylinder_price As Currency, key_price As Currency Dim extension_nbr As Byte Application.EnableEvents = False Application.ScreenUpdating = False With Worksheets("Src_data") discount_rate = Range("fp_discount_rate") base_cyl_price = Application.WorksheetFunction.Index(.Range("tbl_base_cyl_price"), Application.WorksheetFunction.Match(Range("fp_profile"), .Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Range("fp_cyl_type"), .Range("sd_cyl_types"), 0)) extension_nbr = Application.VLookup((Range("fp_ins_length") &amp; Range("fp_out_length")), Worksheets("Extensions").Range("tble_extensions"), 2, False) If extension_nbr &lt;= 10 Then extension_price = extension_nbr * .Range("sd_adval_ext_1") Else extension_price = extension_nbr * .Range("sd_adval_ext_2") If Range("fp_key_type") = "Supplementary key with cylinder" Then base_key_price = Application.WorksheetFunction.Index(.Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Range("fp_profile"), .Range("sd_profiles"), 0), 1) Else If Range("fp_ext_6_yn") = "No" Then base_key_price = Application.WorksheetFunction.Index(.Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Range("fp_profile"), .Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Range("fp_key_type"), .Range("sd_key_types"), 0)) Else: base_key_price = .Range("sd_key_price_6") End If End If If Range("fp_pin") = 6 Then adval_pin = .Range("sd_adval_6pins") Else If Range("fp_pin") = 7 Then adval_pin = .Range("sd_adval_7pins") Else adval_pin = 0 End If If Range("fp_system") = "HS" Then adval_system = .Range("sd_adval_HS") Else If Range("fp_system") = "GHS" Then adval_system = .Range("sd_adval_GHS") Else adval_system = 0 End If If Range("fp_ext_init_yn") = "No" Then adval_not_init = .Range("sd_adval_not_init") Else adval_not_init = 0 If Range("fp_ext_6_yn") = "Yes" Then adval_6months = .Range("sd_adval_6months") Else adval_6months = 0 cylinder_price = (base_cyl_price + extension_price + adval_pin + adval_system + adval_6months) * (1 + adval_not_init) * (1 - discount_rate) Range("fp_cyl_price") = cylinder_price key_price = base_key_price * (1 + adval_not_init) * (1 - discount_rate) Range("fp_key_price") = key_price End With Application.EnableEvents = True End Sub...