Simplification/accélération d'une macro

Bonjour à tous,

Pour commencer bonne année à tous mes meilleurs vœux pour cette nouvelle année qui commence

Je vous expose mon soucis, j'ai créé une macro qui fonctionne très bien en revanche j'ai un petit soucis au niveau des temps d’exécution qui sont relativement long et j'aimerais donc améliorer mon code au niveau de la structure voir changer quelque chose si plus de rapidité est possible (j'en appel donc a votre savoir ). Je ne vous met qu'une petite partie du code qui fait des centaines de lignes en réalité mais qui ce répètes toutes donc si on trouve une solution pour ce petit bout de programme je prendrais soin de l'appliquer à tout mon programme.

Le code:

Option Explicit

Sub MacroS2()

'

' MacroS2

'

'

Dim BoEcran As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean

Dim iCalcul As Integer

BoEcran = Application.ScreenUpdating

BoBarre = Application.DisplayStatusBar

iCalcul = Application.Calculation

BoEvent = Application.EnableEvents

BoSaut = ActiveSheet.DisplayPageBreaks

Application.ScreenUpdating = False (désactivation des options ralentissant l'ordi)

Application.DisplayStatusBar = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

ActiveSheet.DisplayPageBreaks = False

Sheets("extraction 2").Select (je sélectionne une feuille ou les données sont présentes)

ActiveSheet.Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D3 262", Field:=17, Criteria1:="07/01/2019"

Range("B1:M2073").Select

Range("M1").Activate (j'active mes filtres et sélectionne les données dont j'ai besoin)

Application.CutCopyMode = False

Selection.Copy

Sheets("appro S2").Select (je les copies et les colles sur une autre feuille)

Range("B5").Select

ActiveSheet.Paste

End sub

Répétition du code avec des filtres différents (changement de dates en l'occurence)

Voili voilou, si quelqu'un pense avoir une solution pour accélérer tout sa et serait d’accord pour me la transmettre dans son infini gentillesse je lui serait grandement reconnaissant

Merci et à bientôt !

Bonjour

Je ne vois pourquoi vous déclarez toutes ces variables Boolean. Donc sur base de votre info, voici ce que vous pouvez essayer :

Sub xxxx()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

With Sheets("extraction 2")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D3 262", Field:=17, Criteria1:="07/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S2").Range("B5")
End With
'à mettre à la fin de votre code complet
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End sub

Cordialement

Bonjour Dan,

je vous remercie pour votre réponse mais cela ne fonctionne malheureusement pas, je m'explique étant donné que le filtre criteria 1 change de date cela fausse le copier/coller, votre code retiens le premier copier exécuté et le colle à toute les cases de destination renseignées dans le code. Mon code applique les filtres copie/colle, ré-applique un filtre et copie/colle, les données sont les bonnes et vont au bon endroit mais cela prend énormément de temps à s'exécuter. Votre code garde en mémoire une copie et l'applique partout, la copie ne change pas . Avez-vous une solution ?

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D3 262", Field:=17, Criteria1:="15/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("B5")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D3 262", Field:=17, Criteria1:="16/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("B33")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D3 262", Field:=17, Criteria1:="17/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("B53")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D3 262", Field:=17, Criteria1:="18/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("B70")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D3 262", Field:=17, Criteria1:="19/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("B105")
End With
With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="M1 262", Field:=17, Criteria1:="14/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("S5")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="M1 262", Field:=17, Criteria1:="15/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("S33")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="M1 262", Field:=17, Criteria1:="16/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("S53")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="M1 262", Field:=17, Criteria1:="17/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("S70")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="M1 262", Field:=17, Criteria1:="18/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("S105")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D1 262", Field:=17, Criteria1:="15/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("AK5")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D1 262", Field:=17, Criteria1:="16/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("AK33")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D1 262", Field:=17, Criteria1:="17/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("AK53")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D1 262", Field:=17, Criteria1:="18/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("AK70")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D1 262", Field:=17, Criteria1:="19/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("AK105")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D4 262", Field:=17, Criteria1:="15/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("BC5")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D4 262", Field:=17, Criteria1:="16/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("BC33")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D4 262", Field:=17, Criteria1:="17/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("BC53")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D4 262", Field:=17, Criteria1:="18/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("BC70")
End With

With Sheets("extraction 3")
   .Select
   .Range("$1:$2047").AutoFilter Field:=4, Criteria1:="D4 262", Field:=17, Criteria1:="19/01/2019"
   .Range("B1:M2073").Copy Sheets("appro S3").Range("BC105")
End With
'à mettre à la fin de votre code complet
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

En tout cas merci pour votre réponse, j'espère trouver une solution à mon problème.

Bonjour,

Merci de nous mettre un fichier à disposition.

Cdlt.

131.xlsm (381.75 Ko)

Bonjour Jean Eric,

voilà le fichier avec mon ancienne macro, vous comprendrez mieux ce que je souhaite obtenir, c'est exactement cela que je souhaite mais en plus rapide, ne vous étonnez pas de l'agencement du tableur j'ai du supprimer bon nombre de données car confidentielles...

Pour exécuter la macro feuille "appro S51" et bouton afficher tout (en haut de la feuille). Voilà, si quelqu'un (ou quelque chose lol) arrive à m'accélérer tout sa sa serait formidable!

Merci, en attente de votre réponse

Re

Dans votre macro 51, à quoi correspond D3 262, D4 262, Etc...

Pourquoi vous allez jusque la ligne 2047 ? Cela peut varier non ?

En A5 de la feuille Appros51, pourquoi vous ne mettez pas la date 17/12/18 en A5. Idem pour les cellules plus bas

Salut

sur quelle colonne les critères "D3 262" et "28/01/2019" sont inscri

si s agit dune simple assignation des valeur sur autre feuilles, tu peux utiliser autre methode plus rapide a la place de" copier coller "

Bonjour à tous,

Merci pour vos réponses.

Pour commencer Dan, D3 262, D4 262, Etc... correspond à des engins, je vais jusqu'à la ligne 2047 car nous faisons une extraction depuis un site web des tâches que nous avons à réaliser sur les différents engins et cela pour chaque semaine donc autant vous dire que la liste des tâches peut être courte ou longue. Enfin, la date n'est pas en A5 car il nous faut une visibilité sur les tâches à faire sur la journée. Par exemple j'extrait les tâches et il faut que l'autre équipe qui va prendre le fichier voit les tâches de la journée à réaliser.

Amir, le critère "D3 262" se trouve colonne 4 et la date colonne 17 de la feuille extraction. Il s'agit d'une assignation des tâches en fonction de date et d'engins. Merci pour votre temps.

Bien cordialement,

Re

Enfin, la date n'est pas en A5 car il nous faut une visibilité sur les tâches à faire sur la journée.

Vous n'avez pas compris ma question. La date est mise en A5 au format standard. Pourquoi ne pas mettre au format Date ? Idem pour les autres date en colonne A.

Concernant le D3 262, cela se trouve où sur votre feuille Appro S51 ???, on voit bien D3 mais le 262 ??

Autre question comment vous choisissez de filtrer sur D3 262 ou D3 785 ?

Re-bonjour Dan,

la date n'est pas au format date car toutes les données sont extraites depuis un site en ligne il s'agit donc de données brut, si il est possible de les passer en format date via la macro pourquoi pas et surtout si cela est utile. Concernant D3 262, nous ne traitons que les données liées au "262", une autre entité se charge des autres nombres qui peuvent être présent après si cela peut aider de faire figurer 262 je peux le faire. Il s'agit vraiment de faire figurer les tâches de la journée correspondant à un engin (engin D3 262, engin M1 262...).

Merci pour tes réponses Dan elles sont appréciées

Bien cordialement,

Re

la date n'est pas au format date car toutes les données sont extraites depuis un site en ligne il s'agit donc de données brut, si il est possible de les passer en format date via la macro pourquoi pas et surtout si cela est utile.

Ok mais je parle des dates qui se trouve dans la colonne A de la feuille APPRO S51 et pas de la feuille "Extraction". Cela vient d'un site en ligne ???

Concernant D3 262, nous ne traitons que les données liées au "262"...,

Ok pour le D3 262, ma question était par rapport au bouton sur la feuille APPRO S51 qui est lié à la macro S51 et qui concerne la donnée D3 262. Cette donnée D3 262 n'est pas présente dans le fichier que vous avez posté.

Je reviens vers vous plus tard.

Bonjour Dan,

non la date dans la colonne A de la feuille appro S51 ne provient pas d'un site en ligne, on peut la mettre au format date sans problème. Il n'y a que la feuille extraction qui provient d'un site en ligne. Idem pour le D3 262, nous pouvons le faire figurer sur la feuille appro S51, nous avions mit uniquement D3 car nous savions qu'il s'agissait de la 262 mais nous pouvons le faire figurer sans problème c'est même logique à vrai dire.

Re

Merci de vos précisions.

Je vous propose d'utiliser les cellules suivantes :

  • A1 pour la date du lundi choisie
  • A2 pour le chiffre 262 (ou un autre si on veut)

Ok pour vous ?

Autre question dans la feuille ApproS51, on a toujours le même nombre de lignes pour chaque date en colonne A ? Donc date 1 en ligne 5, date 2 en ligne 59, etc... donc 54 lignes pour chaque date ?

Re,

oui, cela me semble bien si vous arrivez a faire un truc bien sa serait génial! Date et 262 OK.

Merci Dan

Et j'oubliais pour les dates, c'est bien 54 lignes par date.

Merci Dan

Salut Dan, Captain_coco

J’essaie de lire l'enregistrement de macro pour comprendre ton demande, Est-ce qu’il s’agit d une simple assignation de valeurs qui regroupes deux critères définit sur une autre onglet :

1123

re

Dans la feuille Appro S51, entre les colonnes O et R vous avez 2 colonnes tandis que plus loin vous avez toujours 3 colonnes vides.

C'est 2 ou 3 colonnes qu'il faut ??

Désolé de mes questions mais il faut structurer la feuille Appro de manière identique et le code est presque terminé.

Bonjour Dan j'espère que le week-end a été bon,

l'idéal serait d'avoir toujours 3 colonnes d'espaces car les opérateurs rentrent régulièrement des informations dans ces espaces.

Amicalement,

Captain

Bonjour AMIR,

étant donnée que Dan a déjà bien avancé sur le sujet je ne vais pas doubler la charge de travail, pour le moment mes considérations sont déjà bien prises en compte par notre cher ami Dan. Merci tout de même pour votre réponse.

Bien cordialement,

Re

Votre fichier en retour

Le bouton est lié à la macro MAJ disponible dans le module 1.

Mettez simplement la date en A1 et le chiffre en A2 (262 dans votre cas), puis cliquez sur le bouton pour la mise à jour

Il vous suffit de changer ces deux données uniquement.

Vous n'avez plus besoin de tous les codes et modules dans votre fichier, je pense

Le code fonctionne sur les deux noms de feuille reprise dans votre fichier. Si vous voulez effectuer sur deux autres noms de feuilles, changer uniquement le nom dans le code au niveau des deux SET =....

Cordialement

102.xlsm (365.31 Ko)
Rechercher des sujets similaires à "simplification acceleration macro"