Soustraction sous VBA d'une base importante

Ce qui est etrange c'est que qd ma base fait 2000 lignes, tout marche et rapidement. 15 000 ligne, tout fonctionne mais en revanche les soustractions ou alors le remplacement des points en virgule sont lognues.et quand la base en fait 50 000 (c'est important mais cela peut arriver) et bien là les soustractions et le remplacement des points est tres tres long et le TCD lui est mis en echec au moment du Addfiels.

Tu n'as pas ajouté application.screenupdating = false au début du code, ça accélèrera sans doute le remplacement.
Pour ton TCD je ne sais pas non.
Peut-être un problème de mémoire, refais un test après un reboot.

eric

Tres bien je vais essayer cela demain car les fichiers sont au boulot. C'est embetant cette histoire de mémoire, une action qui marche sur excel peut bloquer sur VBA a cause de la mémoire ? Après il est vrai que le PC du boulot n'est pas top. Comment on peut résoudre cela ?

Si ta macro marche sur un petit fichier et plus sur un grand alors que manuellement ça passe j'ai du mal à imaginer autre chose mais il y a peut-être une autre explication.
Pas assez de ram tu passes sur la mémoire virtuelle (ça ralenti...) et si pas assez de mémoire virtuelle (à contrôler) ça plante (?)

En tout cas tu m'as deja trouvé une bonne partie de la solution. Je vais tester demain l'instruction que tu as indiqué pour voir si ca améliore la performance. Peut etre que quelqu'un en lisant le forum aura une idée d'où ca peut venir.

Pas de mal michel ;-)
bonne soirée

Bonsoir michel,

Ce code me donnera quelle réponse ? excuse moi je suis novice en VBA. y'a aps de tcd ou de soustraction dans ce code ?

A partir de quel moment je dois placer ce code ? (je le ferai demain car les fichiers sont au boulot)

merci Michel cela améliore considérablement la vitesse (pour les grosses bases). En revanche,le tcd plante tjrs dès l'étape du addfields. j'ai essayé de le faire chez moi et là tout fonctionne. Donc cela doit être une histoire de ressources insuffisante sur le pc entreprise ?

En revanche ta macro ne marche pas sur excel 2007 (version que j'aie à la maison) donc j'ai du retenter avec la version d'Éric. tout fonctionne (malgré la version 2007) ça a mis 2 heures mais cela a fonctionné pour la soustraction et pour le tcd ensuite (incroyable).

Pour tester et confirmer que c'est un probleme de ressources au boulot, pourrais tu me dire quoi changer ds ton code pr que la soustraction fonctionne meme sur vba 2007 ?

Cordialement

Bonjour,

cela améliore considérablement la vitesse
Note que dès le début je t'ai proposé de mettre le résultat plutôt que la formule, sans obtenir de réponse de ta part...
https://forums.commentcamarche.net/forum/affich-26873406-appliquer-une-formule-jusqu-a-la-derniere-ligne-des-variables#6

eric

Ca y est michel, j'ai placé un code et le fichier ds la discussion c-dessous. Je remarque que j'avais pas vu que tu demandais 3000 lignes. Cela est il genant pr ton test de la soustraction si je n'ai mis que qques ligne ? De toute facon je le retesterai tout de suite apres sur une base bien plus grande. Mais là qd je lance le code j'ai l'impression que ce n'est meme pas le nombre de ligne qui le gene, mais le code en lui meme.

En te remerciant

Tu as écris:
Pour information, la macro (malgré la longueur) est allée au bout avec une base de 16 000 lignes
pour augmenter la rapidité d'une procédure CE QUI EST TA DEMANDE, et sans connaitre VBA ,il est évident que sur 14 lignes on testera rien du tout

La partie de la macro pour soustraire - testée avec succès sur 2007

Dim Derlig As Long, T_in(), T_out(), cptr As Long  

Application.ScreenUpdating = False  
Derlig = Columns("A").Find("*", , , , , xlPrevious).Row 'dernière ligne avec des données  
T_in = Range("D2:E" & Derlig).Value  
Columns("F").Insert  
Range("F1") = "Libellé écriture"  
T_out = Application.Transpose(Range("F2:F" & Derlig).Value)  

For cptr = 1 To UBound(T_in)  
     If T_in(cptr, 1) <> "" Then  
          If T_in(cptr, 2) <> "" Then T_out(cptr) = Replace(T_in(cptr, 1), ".", ",") - Replace(T_in(cptr, 2), ".", ",")  
     End If  
Next  

With Range("F2:F" & Derlig)  
     .Value = Application.Transpose(T_out)  
     .NumberFormat = "##0.00"  
End With  

mais;
je me demande l'utilité des tests que tu indiquais au départ
If Cells(i, "D") <> "" And Cells(i, "E") <> ""
puisqu'il y a des données dans tes 14 lignes

d'autre part n'oublie pas de réduire la surface requise pour ton TCD (déjà signalé sans aucune réaction de ta part), car tu risques de ramer et de saturer la RAM et/ou la mémoire virtuelle de ton disque dur:
Range ("A1:R65000") à remplacer par
Range ("A1:R" & derlig")

en fait le test If cells, il me semble, etait présent pour dire à la macro de faire la soustraction sur toute la colonne (hors en tete) mais jusqu'à la derniere ligne. Car la premiere macro que je m'etais fait faisait que des soustractions étaient calculées meme apres la base et donc donnait une liste de 0 sur toute la colonne. Je vais aussi remplacer le champ range. et voici un nouceau lien avec un fichier d'environ 3800 lignes : http://cjoint.com/13jv/CAtq2GEVLQq.htm

Aussi, j'ai voulu ajouter le terme : Range("A1:R" & derlig").Select dans le code ci dessous mais du coup VBA dit qu'il ne reconnait plus l'objet global.

Voici le code :

Application.ScreenUpdating = False
Columns("D:E").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Range("F1").Select
ActiveCell.FormulaR1C1 = "Montant solde"
Dim Derlig As Long, T_in(), T_out(), cptr As Long
Derlig = Cells.Find("*", , , , , xlPrevious).Row
T_in = Application.Transpose(Range("D2:E" & Derlig).Value)
T_out = Application.Transpose(Range("F2:F" & Derlig).Value)

For cptr = 1 To UBound(T_in)
If T_in(cptr, 1) <> "" Then T_out(cptr) = T_in(cptr, 1) - T_in(cptr, 2)
If T_in(cptr, 2) <> "" Then T_out(cptr) = T_in(cptr, 1) - T_in(cptr, 2)

Range("F2:F" & Derlig) = Application.Transpose(T_out)
Next cptr
Application.ScreenUpdating = True
Range("A1:R" & "derlig").Select
Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"A1:R" & "derlig").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
Array("CGR A", "Poste", "Libellé réduit du compte", "Libellé", "Libellé écriture", _
"Date Compt", "Pièce", "Ets")
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Montant solde")
.Orientation = xlDataField
.NumberFormat = "#,##0"
End With

P....!
JE PASSE DU TEMPS POUR TE DONNER UN CODE ET TU TE BORNES A RECOPIER TES ANERIES

ALORS DEM... TOI TOUT SEUL

J'essaie de recopier le code comme toi et eric me l'ont corrigé. ici j'ai ajouté A1:R" & "derlig comme tu me l'a dit juste avant. à moins que j'ai mal compris. Désolé pour le derangement. Mais sache que je ne suis pas du tout informaticien de formation.