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

Accélérer exécution

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
 

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
 

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
 

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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…