Accélérer le code

[Namzip]

Bonjour à tous,

J'ai un tableau de noms avec en colonne les jours du mois.(Feuille liste)
Je dois recopier les heures passées pour ce même mois par une auxiliaire (Feuille Mois)

J'ai un bouton de commande "Transfert" qui appelle une macro tansfert

Il s'agit de trois boucles For Next imbriquées.

Bref, ça rame.

Avez vous une astuce pour accélérer ce code?

Merci à vous tous pour votre temps.

Bien cordialement, Robert

 

[gwenlorin]

Re : Accélérer le code

Bonjour,

En début de ta procédure met :

Public Sub Transfert()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Ca bloque la mise à jour de l'affichage et le recalcul des fonctions.

et en fin

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Ca ira déjà mieux

A+

 

[gwenlorin]

Re : Accélérer le code

Re,

un code un peu plus rapide :

Public Sub Transfert()
Dim foundcell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Nbjour = Sheets("Liste").Range("E2").Value
Nbbene = Sheets("Liste").Range("B2").Value
For B = 1 To Nbjour
    For M = 1 To 49
        Bene = Sheets("Mois").Cells(3 + M, B * 2).Value
        Set foundcell = Sheets("Liste").Columns(3).Find(What:=Bene, LookIn:=xlValues, LookAt:=xlWhole)
        If Not foundcell Is Nothing Then
           Sheets("Liste").Cells(foundcell.Row, 5 + B).Value = Sheets("Mois").Cells(3 + M, (B * 2) + 1).Value
        End If
    Next M
Next B

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Namzip]

Re : Accélérer le code

Bonsoir à vous deux (aux autres aussi bien sur ;-) )

Merci, à peine testé la première solution (désactivation) qu'une seconde bien plus rapide est déjà là!!!!!!

Ca marche aux petits oignons même si je n'ai pas tout compris.


Edit: Je te remercie deux fois, excuse moi, c'est l'émotion!!!!!!!

Bien cordialement, Robert

 

[gwenlorin]

Re : Accélérer le code

De rien

N'hésite pas pour toute question ou complément

 

[Gael]

Re : Accélérer le code

Bonjour Namzip, Gwenlorin,

Namzip, j'ai regardé ton fichier et il y a un point que je ne comprends pas, lorsqu'un même nom est présent plusieurs fois dans une même journée ses heures ne sont pas totalisées, seule la dernière valeur est prise en compte.

J'ai fait une autre procédure, avec une logique différente et qui totalise les heures, mais je ne sais pas si j'ai bien compris.

Public Sub Transfert()
Dim Tablo As Variant, Lig As Integer
Nbjour = Sheets("Liste").Range("E2").Value
Nbbene = Sheets("Liste").Range("B2").Value
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Création d'un tableau en mémoire avec les données de la feuille "Mois"
Tablo = Sheets("Mois").Range("A4:BK52")
'Création d'une liste indexée des noms avec le numéros de ligne correspondants
Set Noms = New Collection
With Sheets("Liste")
    For O = 7 To Nbbene + 6
        Noms.Add O, .Cells(O, 3)
        Range(.Cells(O, 6), .Cells(O, 36)).ClearContents
    Next O
End With
On Error Resume Next
For B = 1 To Nbjour
        For M = 1 To 49
            Err.Clear
            If Tablo(M, 2 * B) <> "" Then
            Lig = Noms(Tablo(M, 2 * B))
            If Err.Number = 0 Then Sheets("Liste").Cells(Lig, 5 + B) = Sheets("Liste").Cells(Lig, 5 + B) + Tablo(M, 2 * B + 1)
            End If
        Next M
Next B
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

@+

Gael

 

[Namzip]

Re : Accélérer le code

Merci à vous deux (cette fois c'est possible)

Oui, Gael, je dois additionner les heures non seulement pour la journée liée à une auxiliaire mais aussi celles réalisées par d'autres auxiliaires.

En fait, j'ai un répertoire avec le fichier mensuels de chaque auxiliaires (14 intervenantes)

J'ouvre un fichier que je copie dans la page mois puis la sub Transfert ventile les heures réalisées.

Je vais passer un peu de temps sur vos solutions car elles utilisent des fonctions nouvelles pour moi.

Encore merci à ce forum et à tous ceux qui donnent de leur temps pour aider !!!

Cordialement, Robert