Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Accélérer exécution

M

Micka2305

XLDnaute Nouveau
Bonjour, la macro suivante fonctionne très bien mais elle met environ 30 secondes à s'exécuter.
Auriez vous une idée pour accélérer son exécution?

En vous remerciant,
Mickael

Sub validerbondenlevement()

Dim Rep As Integer


Rep = MsgBox("Voulez vous vraiment valider et envoyer le " & Range("D3") & "?", vbYesNo + vbQuestion, "Attention")


If Rep = vbYes Then
ActiveSheet.Unprotect

If Range("D7").Value <> 0 Then
If Range("F7").Value <> 0 Then

derlig = Sheets("bon de livraison").Cells(Cells.Rows.Count, "D").End(xlUp).Row
derligstock = Sheets("Stock").Cells(Cells.Rows.Count, "E").End(xlUp).Row
derligjourn = Sheets("Journal de bord").Cells(Cells.Rows.Count, "A").End(xlUp).Row

' Sortie ====> Stock

'je parcours les lignes des entr_es
For Each c In Sheets("bon de livraison").Range("D1352" & derlig)

'je parcours les lignes des stocks
For Each d In Sheets("Stock").Range("E2:E" & derligstock)
'si article stock = article entr_e alors
If c = d Then
'valeur stock + valeur entr_e
d.Offset(0, 6) = d.Offset(0, 6) + c.Offset(0, 1)
End If
Next
Next


' Sortie ====> Journal
derligjourn = derligjourn + 1
'je parcours les lignes des sorties
For Each c In Range("C13:C52")
'je m'assure que la sortie n'est pas vide pour eviter une insertion d'une ligne vide
If c <> 0 Then
'je saisie que c'est une sortie
Sheets("Journal de bord").Range("A" & derligjourn).Value = "Sortie"
Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 1) = Sheets("bon de livraison").Range("D7")
Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 2) = Sheets("bon de livraison").Range("F7")
'je saisie la designation
Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 3) = c.Offset(0, 1)
Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 4) = c.Offset(0, 2)
Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 5) = c.Offset(0, 4)
'je saisie la quantit_

'je saisie la date
Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 6) = Date
'j'incremente le numero de ma derniere ligne
derligjourn = derligjourn + 1
End If
Next


Range("C13:C52").ClearContents






MsgBox "Bon de livraison validé. Le stock est actualisé."




Else
MsgBox ("Attention: veuilez entrer le nom du client/chantier avant de valider")
End If
Else
MsgBox ("Attention: sélectionner votre nom avant de valider")
End If
End If
 
Trier par date Trier par votes

pierrejean

XLDnaute Barbatruc
Re

A tester:
VB: 
Sub envoyerpdfmail()
 
    Dim Rep As Integer
    

     Rep = MsgBox("Voulez vous vraiment valider et envoyer le " & Range("D3") & "?", vbYesNo + vbQuestion, "Attention")
    
    
     If Rep = vbYes Then
     ActiveSheet.Unprotect
  
     If Range("D7").Value <> 0 Then
     If Range("F7").Value <> 0 Then

    derlig = Sheets("bon de livraison").Cells(Cells.Rows.Count, "D").End(xlUp).Row
    derligstock = Sheets("Stock").Cells(Cells.Rows.Count, "E").End(xlUp).Row
    derligjourn = Sheets("Journal de bord").Cells(Cells.Rows.Count, "A").End(xlUp).Row

    ' Sortie ====> Stock


    For Each c In Sheets("bon de livraison").Range("D13:D" & derlig)
       If c <> " " Then

        Set d = Sheets("Stock").Columns("E").Find(c, LookIn:=xlValues, lookat:=xlWhole)
        If Not d Is Nothing Then
            d.Offset(0, 6) = d.Offset(0, 6) + c.Offset(0, 1)
        End If
     End If
    Next


    ' Sortie ====> Journal
    derligjourn = derligjourn + 1
    'je parcours les lignes des sorties
    For Each c In Range("C13:C52")
        'je m'assure que la sortie n'est pas vide pour eviter une insertion d'une ligne vide
        If c <> 0 Then
            'je saisie que c'est une sortie
            Sheets("Journal de bord").Range("A" & derligjourn).Value = "Sortie"
            Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 1) = Sheets("bon de livraison").Range("D7")
            Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 2) = Sheets("bon de livraison").Range("F7")
            'je saisie la designation
            Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 3) = c.Offset(0, 1)
            Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 4) = c.Offset(0, 2)
            Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 5) = c.Offset(0, 4)
            'je saisie la quantit_
 
            'je saisie la date
            Sheets("Journal de bord").Range("A" & derligjourn).Offset(0, 6) = Date
            'j'incremente le numero de ma derniere ligne
            derligjourn = derligjourn + 1
        End If
    Next


   Range("C13:C52").ClearContents
        
        
    



    MsgBox "Bon de livraison validŽ. Le stock est actualisŽ."



  
Else
MsgBox ("Attention: veuilez entrer le nom du client/chantier avant de valider")
End If
Else
MsgBox ("Attention: sŽlectionner votre nom avant de valider")
End If
End If
ActiveSheet.Protect
End Sub
 
Vote positif 0 Vote négatif
M

Micka2305

XLDnaute Nouveau
Bonsoir,
Merci énormément c'est super !!!

Pourriez vous m'aider à nouveau sur ce fichier?
Lorque je rentre une référence sur le bon d'enlèvement (dans la cellule prévue à cette effet) la quantité s'affiche bien. Cependant lorsque je rentre à nouveau la même référence, les quantités au lieu de s'ajouter s'écrive à coté (exemple: 1010 avec un colisage de 10).

En vous remerciant,
Mickael
 
Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc
Re
Je ne constate pas ce phénomène
Toutefois essayer
remplacer
If bb Then 'Existe dans le bon de livraison (Existe forcŽment dans le stock)
Set e = Sheets("stock").Columns(2).Find(target.Value, LookIn:=xlValues, lookat:=xlWhole)
b.Offset(, 2) = b.Offset(, 2) + e.Offset(, 5)
par
If bb Then 'Existe dans le bon de livraison (Existe forcŽment dans le stock)
Set e = Sheets("stock").Columns(2).Find(target.Value, LookIn:=xlValues, lookat:=xlWhole)
b.Offset(, 2) = b.Offset(, 2) * 1 + e.Offset(, 5) * 1
Si pas de résultat me préciser un exemple de saisie provoquant cette erreur
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
135
escudo
E
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
F
  • Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
302
Oneida
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
463
arnoldbrice19
A
A
  • Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
280
sylvanu
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
363
Dranreb
G
  • Résolu(e)
XL 2010 Obliger la validation d'un bouton d'option.
Réponses
8
Affichages
334
gillesda
G
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
P
  • Résolu(e)
Microsoft 365 Problème avec Application.undo
Réponses
2
Affichages
170
pat66
P
E
  • Résolu(e)
XL 2019 chercher une date dans une colonne vba
Réponses
12
Affichages
473
sylvanu
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…