Réduction délai traitement

Bonjour,

J'aimerais avoir un coup de main pour réduire le temps de traitement, qui d'ailleurs fait planter mon pc à un moment donné, de mon programme ci dessous.

L'objectif de ce programme est de comparer 2 fichiers excel. Le premier, WBA, est le fichier que j'utilise et dans lequel j'ai un certains nombre de lignes (le nombre de colonnes est fixe pour les 2 fichiers). Dans une colonne je rempli des commentaires.

Le 2em fichie, WBB, est un fichier extrait d'un logiciel qui est la version à jour du premier document hormis qu'il ne contient pas de commentaire. Je dois donc, au travers d'une macro comparer les 2 fichiers ligne par ligne pour vérifier s'il y en a de nouvelles. Le cas échéant insérer une ligne et copier la ligne de WBB vers WBA. Si pas de copie on ne touche pas à la ligne pour garder les commentaires.

Je ne trouve pas le moyen de faire quelque chose de rapide...

Sub MAJ()

Application.Calculation = xlCalculationManual

Dim WBB As Workbook 'fichier servant pour la mise a jour

Dim WBA As Workbook 'fichier à mettre à jour

Dim wsb As Worksheet

Dim wsa As Worksheet

Dim compteura

Dim compteurb

Dim derlig As Long

'Application.ScreenUpdating = False

Workbooks.Open Filename:="C:\Users\Jeremy.Caseteuble\Desktop\EDV\Nouveau.xlsx"

'indexation des fichiers et des feuilles

Set WBB = Workbooks("Nouveau.xlsx")

Set WBA = Workbooks("Extractiondutableaudesprojetstest.xlsm")

Set wsb = WBB.Worksheets("Extractiondutableaudesprojetste")

Set wsa = WBA.Worksheets("Extractiondutableaudesprojetste")

Set WBA = ActiveWorkbook

wsa.Activate

'derniere ligne plage de donnéeWBB.wsb.Activate

derlig = wsb.Range("A" & Rows.Count).End(xlUp).Row

'MsgBox (derlig)

compteura = 8

compteurb = 8

Do While compteurb <= derlig

If wsa.Cells(compteura, 9) <> wsb.Cells(compteurb, 9) Then

'wsa.Cells(compteura, 1).Select

'MsgBox ("selection")

wsa.Cells(compteura, 1).Insert Shift:=xlDown

'MsgBox ("insertion")

wsb.Range("A" & compteura & ":AE" & compteura).Copy

'MsgBox ("copy")

wsa.Cells(compteura, 1).EntireRow.PasteSpecial

'MsgBox ("colle")

compteura = compteura + 1

compteurb = compteurb + 1

'MsgBox (compteura & " " & compteurb)

Else

compteura = compteura + 1

compteurb = compteurb + 1

'MsgBox ("else" & compteura & " " & compteurb)

End If

Loop

Application.Calculation = xlCalculationAutomatic

'Application.ScreenUpdating = True

End Sub

Bonjour,

La macro est-elle dans le WbA ?

Il serait bon de fournir un fichier Source Test (au moins quelques lignes)

On n'est obligé d'avoir envie de créer des fichiers bidons avec des noms à rallonge alors que toi tu a ça tout cuit sur ton bureau.

A+

Je ne peux pas envoyer le contenu par soucis de confidentialité, il faut imaginer qu'il y a environ 4000 lignes, et que ce chiffre augmentera avec le temps

Bonjour,

Bon de toute façon il faut te dire qu'on n'obtiendra pas un gain conséquent avec ta méthode qui est très chronophage.

Normalement on ne compare pas 2 plages mais 2 Array ce qui est au moins 20 fois plus rapide que de comparer les feuilles. Ensuite on n'insère pas de ligne, on rajoute les infos manquantes dans l'Array cible (à la fin) et quand c'est fini on colle toussa à la place de prévu puis on trie...

Après il faut qu'on discute... Parce que s'il y a des formules dans le classeur cible, ça peut éventuellement poser problème. Mais il n'y a pas de problème qui n'aient pas de solution.

C'est pourquoi un petit Fichier Source et un petit Fichier Cible Test serait pas de refus... Pas besoin de 25000 lignes hein ! 2 ou 3 suffisent pour se faire une idée de la problématique...

(Des données bidon hein !) L'entête du tableau ou le n° de Compte chèque de l'entreprise on s'en fout...

A+

J'ai appris le vba sur le tas donc je me doute qu'il y a de meilleures méthodes, cest pour cela que je demande de l'aide.

Sinon pour les fichiers, dans mon message précédent j'ai fourni le fichier mais sans les lignes, il suffit juste de mettre un caractère dans quelques lignes pour faire un essai, je ne peux pas fournir les données originelles.

Il faut aussi copier le fichier et renommer la copie"Nouveau.xlsx" et on peut lancer le test.

J'essai une autre méthode actuellement mais j'y passe un temps fou

(Des données bidon hein !) L'entête du tableau ou le n° de Compte chèque de l'entreprise on s'en fout...

Si tu veux tirer un minimum de profit du forum il va falloir que tu y mettes du tien. Des données absurdes du genre titi, toto, tata, tutu, caca, popo... ne serviraient à rien : Il faut des données qui pour bidon qu'elles soient restent vraisemblable. Afin d'adapter le code aux données. En VBA pas d'égalité qui tienne. Si toto est un nom, tata une date, tutu un N° d'ordre et autres joyeuseté comment tu veux qu'on s'y retrouve les yeux bandés ?

Le forum ne fonctionne pas avec des boules de cristal. Et si tu regardes un certain nombre de sujets sur différents forum tu verras que la plupart des habitués proposent des fichiers qui parlent plus ou moins de leur profession, sans pour autant divulguer de secrets même s'ils travaillent dans des banques ou des centrales nucléaires...

Enfin c'est toi qui voit.

A+

Ce n'est pas la première fois que je vais sur un forum. Je vais essayer de faire un fichier test demain, j'ai d'ailleurs oublié de précisé que les seules cases qui m'intéressent pour la comparaison sont dans la colonne 9. En gros c'est la seule variable le reste on s'en fou un peu puisque la ligne sera copié. Mais si tu veux des données bidons pour que ce soit visuelle pas de soucis je fais ça dès que possible.

Je veux aussi et surtout que tu répondes aux questions suivantes :

  • La macro est-elle dans le WbA ? (ou dans un classeur tiers, macro complémentaire etc...)
  • Au lieu d'insérer les lignes manquantes peut-on les rajouter à la fin puis trier ?
  • S'il y a des formules dans le classeur cible il faut les faire apparaitre. (pour vérifier si elles permettent le tri)
A+

Je veux aussi et surtout que tu répondes aux questions suivantes :

- La macro est-elle dans le WbA ? (ou dans un classeur tiers, macro complémentaire etc...)

La macro est dans le module 1 de mon fichier, je ne sais pas ce qu'est le wba.

- Au lieu d'insérer les lignes manquantes peut-on les rajouter à la fin puis trier ?

Cela ne me dérangerait pas. Je suppose que l'on peut mais cela me paraissait trop compliqué à coder.

- S'il y a des formules dans le classeur cible il faut les faire apparaitre. (pour vérifier si elles permettent le tri)

Il n'y a pas de formule dans les classeurs, uniquement du contenu texte/chiffres.

J'ai préparé les fichiers comme convenu, celui s'appelant "Extractiondutableaudesprojetstest.xlsm" est le fichier de travail ou l'on va remplir les cases de la colonne AE (en rouge) et qui doivent être conservé à chaque mise à jour.

La mise à jour (macro) doit permettre d'ajouter les lignes provenant du fichier "Nouveau.xlsx" qui manquent au fichier de travail.

En jaune les données, en orange les lignes ajoutés dans le fichier "Nouveau.xlsx".

La colonne N° de sous projet me sert à faire la comparaison entre les 2 fichiers. Quand le N° de sous projet n'existe pas dans le fichier de travail mais qu'il est présent dans la MAJ, la ligne doit être copier dans le fichier de travail.

J'ai essayé d'être clair et de fournir tout ce que je pouvais, n'hésite pas à me dire si il manque des infos.

Cdlt

2nouveau.xlsx (522.74 Ko)

Bonjour,

J'ai travaillé une partie de la matinée sur ce projet et je vais devoir m'interrompre : Je ne pourrai reprendre qu'en fin d'après midi. Mais d'ors et déjà j'ai une mauvaise nouvelle : Ton projet ne comporte aucun index. Pire la colonne A comporte de nombreux doublons ! Ça veux dire qu'on ne peut faire que comme tu as fais.

Comparer ligne par ligne et insérer au fur à mesure...

Je ferai certainement quelques retouches mais ça sera purement cosmétique. Si tu ne me déniches pas une colonne indexable sans doublon, pas grand chose à espérer en terme d'optimisation.

A+

Tout d'abord merci pour le temps accordé.

Oui exact c'est ce qui me pose problème, ce fichier provient d'une extraction d'un logiciel dont je ne peux pas modifier le contenu. Donc je ne peux pas, actuellement, ajouter une colonne index c'est pour cela que je me suis tourné vers ce programme.

Avec 4134 lignes j'arrive à faire le "tri" en à peu près 3-4 minutes, ce n'est pas parfait mais comme c'est une opération hebdomadaire ce n'est pas la fin du monde... J'aurais aimé raccourcir ce délai autant que possible surtout car ce fichier ne fera que grossir et je ne veux pas devoir tout recommencer dans quelques mois.

PS: Cela fonctionne mais je ne sais pas pourquoi j'ai des lignes ne contenant que la première colonne (les dates) qui s'ajoutent, comment ne plus les avoir?

Je vais gratter dessus ce soir et je te dis.

Ok super merci!

Bon finalement ça me semble moins pire que je ne pensais à première vue.

En effet j'avais regardé et lu un peu rapidement mais en fait ta macro n'a pas besoin d'insérer : Elle ne fait qu'AJOUTER des lignes. à l'existant.

Aussi c'est très simple. YAKA remplacer ta macro par celle-cj :

Sub MAJ()
Dim WbS As Workbook 'fichier servant pour la mise a jour "Source"
Dim WbC As Workbook 'fichier à mettre à jour "Cible"
Dim WsS As Worksheet
Dim WsC As Worksheet 'feuilleCible

Dim ArrS, ArrC, iR&, iC%, iLRC&, iLRS&, rng As Range

Application.ScreenUpdating = False

Workbooks.Open Filename:="C:\Users\Jeremy.Caseteuble\Desktop\EDV\Nouveau.xlsx"
'instanciation des fichiers et des feuilles et des variables Array
Set WbS = Workbooks("Nouveau.xlsx")
Set WbC = ThisWorkbook
Set WsS = WbS.Worksheets("Extractiondutableaudesprojetste")
Set WsC = WbC.Worksheets("Extractiondutableaudesprojetste")

'WbS est le classeur actif
With WsS
   iLRS = .Range("A" & .Rows.Count).End(xlUp).Row
   Set rng = .Range("A8:AE" & iLRS) 'Tableau source
End With
ArrS = rng.Value
With WsC
   iLRC = .Range("A" & .Rows.Count).End(xlUp).Row
   Set rng = Range("A8:AE" & iLRS) 'La cible doit être dimensionnée comme la source
End With
ArrC = rng.Value
iC = 31 'Le nombre de colonnes est 31
For iR = LBound(ArrS) To UBound(ArrS)  'On parcourt toute les lignes du tableau source
   If Not ArrS(iR, 9) = ArrC(iR, 9) Then  'Si l'une d'elle est différente...
      iLRC = iLRC + 1                     'Alors on la recopie dans le tableau cible
      For iC = 1 To 31                    'de la première colonne à la dernière
         ArrC(iLRC, iC) = ArrS(iR, iC)
      Next
   End If
Next
Range("A8:AE" & iLRS) = ArrC        'A la fin on recopie le tableau complété dans le classeur cible
WbS.Close  SaveChanges:=False 'Et on ferme le classeur source
End Sub

Bon c'est pas très optimisé, on pourrait encore faire mieux (pas besoin de parcourir les premières lignes, on pourrait commencer directement par les dernières...) mais comme ça ne prend que quelques secondes je pense que ça suffira amplement.

S'agissant d'ajouts, il n'y a même pas besoin de trier puisque ça s'inscrit dans l'ordre...

Tu me diras.

A+

Merci, cela me semble parfaitement adapté! Cependant j'ai copié le code dans mon fichier mais il ne se passe absolument rien, hormis l'ouverture et la fermeture du fichier source, une idée?

Pas de message d'erreur... RAS ?

Dans ton fichier source (le fichier que tu avais joint) j'ai du renommer la feuille car elle s'appelait "Feuil1"

Bon moi je peux pas deviner... Si les classeurs ne comportent qu'une feuille tu peux écrire Worksheets(1) à la place du nom à rallonge...

Je te donne mon fichier de test...

A+

Nan aucun message d'erreur cela ne fait qu'ouvrir puis fermer le fichier source.

J'ai bien sûr vérifié le nom des fichiers ainsi que des feuilles mais RAS.

J'ai aussi fais le test avec le fichier que tu m'a envoyé et il ne se passe rien de plus.

Chez toi cela fonctionne?

J'ai mis des Msgbox dans chaque boucle, elles s'executent toutes a priori mais il n'y a rien dans le fichier cible.

Je me trompe peut -être mais il me semble qu'il manque l'instruction de copier coller la ligne?

For iR = LBound(ArrS) To UBound(ArrS) 'On parcourt toute les lignes du tableau source

If Not ArrS(iR, 9) = ArrC(iR, 9) Then 'Si l'une d'elle est différente...

iLRC = iLRC + 1 'Alors on la recopie dans le tableau cible

Pfff... Sorry !

Modifie cette ligne :

WsC.Range("A8:AE" & iLRS) = ArrC 'A la fin...

Autre possibilité : Intervertir les 2 dernières lignes :

...
WbS.Close SaveChanges:=False        'on ferme le classeur source
Range("A8:AE" & iLRS) = ArrC        'Et on recopie le tableau complété dans le classeur cible
End Sub

A+

En modifiant la ligne cela effectue bien la copie du tableau, cependant il y a un soucis majeur c'est que cela ne garde pas les commentaires (dates) de la colonne AE. J'ai modifié le code pour que la copie s'arrète en AD mais cela ne décale pas les commentaires quand des lignes sont ajoutés

Rechercher des sujets similaires à "reduction delai traitement"