Microsoft 365 Vba Index Equiv

eric72

XLDnaute Accro
Bonjour à tous,
j'ai un fichier avec des archives qui comprennent 3600 colonnes et 577 lignes, j'ai un planning dans lequel lorsque je selectionne une année et une semaine (date du 1er jour de la semaine le lundi), j'aimerais récupérer les infos indiquées dans les archives, j'ai un code qui fonctionne dans l'évènement de la feuille mais c'est long(et encore je l'ai fait que pour une équipe et il y en a 8, y-a-t-il un moyen d'accélerer ce code?
compte tenu du poids du fichier j'ai du réduire le nombre de lignes et colonnes.
Merci beaucoup pour votre aide
Eric
 

Pièces jointes

  • Planning TEST.xlsm
    323.3 KB · Affichages: 7
Solution
Re bonjour,
En déplaçant les lignes ici peut être. Attention, jy ai rajouté une ligne
Application.EnableEvents = False au DEBUT
Application.EnableEvents = True à la FIN

Pour le début
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("n4:t4")) Is Nothing Then Sheets("Planning").Range("al4:aq4").ClearContents
   If Not Intersect(Target, Range("al4:aq4")) Is Nothing Then
        If Sheets("Planning").Range("n4") <> "" And Sheets("Planning").Range("al4") <> "" Then
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            Application.EnableEvents = False

et pour la fin
VB:
    .[bk57].Value = Sheets("Archives").Cells(69, colcible5)...

Lolote83

XLDnaute Barbatruc
Bonjour @eric72 ,
Tu peux améliorer la rapidité de ton code comme ceci dans un premier temps
en début
1680781553242.png

puis à la fin
1680781593778.png

Sinon, il faudrait revoir l'ensemble du code mais pas le temps actuellement
Bonne continuation
@+ Lolote83
 

Lolote83

XLDnaute Barbatruc
Re bonjour,
En déplaçant les lignes ici peut être. Attention, jy ai rajouté une ligne
Application.EnableEvents = False au DEBUT
Application.EnableEvents = True à la FIN

Pour le début
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("n4:t4")) Is Nothing Then Sheets("Planning").Range("al4:aq4").ClearContents
   If Not Intersect(Target, Range("al4:aq4")) Is Nothing Then
        If Sheets("Planning").Range("n4") <> "" And Sheets("Planning").Range("al4") <> "" Then
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            Application.EnableEvents = False

et pour la fin
VB:
    .[bk57].Value = Sheets("Archives").Cells(69, colcible5): .[bl57].Value = Sheets("Archives").Cells(70, colcible5): .[bm57].Value = Sheets("Archives").Cells(71, colcible5): _
    .[bm62].Value = Sheets("Archives").Cells(72, colcible5): .[bm63].Value = Sheets("Archives").Cells(73, colcible5):
    
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = False

    
    End With
Chez moi, c'est du coup "presque instantané"
@+ Lolote83
 

Statistiques des forums

Discussions
311 720
Messages
2 081 889
Membres
101 831
dernier inscrit
gillec