Soustraction sous VBA d'une base importante

[Fermé]
Signaler
-
 yanounou -
Bonjour,


Je souhaiterais faire une soustraction d'une colonne D - colonne E et afficher le resultat sur la F. Et ce, tant qu'il y a des nombres sur la colonne D ou E.

Vous m'avez déjà aidé pour trouver le code que je vais saisir ci-dessous et je vous en remercie.

En revanche, j'ai remarqué que sur un fichier de plusieurs dizaines de milliers de lignes, la macro prenait 5 à 10 minutes. Ce qui m'étonne car via excel la soustraction est quasiment instantanée.

Sachant que je dois utiliser VBA, auriez vous une idée pour modifier le code pour que ca prenne moins de temps. au pire 30 secondes à 1 munute, mais au delà cela n'est plus efficace.

En vous remerciant par avance

Dim lg, i As Long
With ActiveSheet.Range("D1:E65000")
lg = .Row + .Rows.Count - 1
End With
For i = lg To 2 Step -1
If Cells(i, "D") <> "" And Cells(i, "E") <> "" Then
Cells(i, "F").FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
Next i

Excel 2003

6 réponses

Messages postés
24205
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 octobre 2021
6 937
Bonjour,

Ca sert à quoi de poser la question si tu ne testes pas toutes les réponses ?
Voir ici :
https://forums.commentcamarche.net/forum/affich-26873406-appliquer-une-formule-jusqu-a-la-derniere-ligne-des-variables#10
Ce n'est pas parce qu'il n'y a pas de boucle et une seule ligne que c''est incomplet. C'est juste plus rapide parce qu'il n'y a pas de boucle justement.
Rien à rajouter, éventuellement
Application.screenupdating=false devant et
Application.screenupdating=true après.

eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.
Bonsoir,

Désolé Eric. Il est vrai que comme la formule fonctionnait je n'ai pas testé la votre. Mais quand j'ai voulu la testé sur une base plus grande cela n'alalit plus (lenteur).

Voici un code où j'ai utilisé votre code. Et cela marche malgré une longueur mais qui ne vient pas de votre code mais des remplacement des "." par des ",".

En revanche je ne sais plus pourquoi dorénavant le tableau croisé dynamique ne veut plus fonctionner. Pour information en plus de vouloir faire une soustraction dans cette base, je l'utilise par la suite pour créer un VBA.

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"
[F2].Resize(Application.Min(Cells(Rows.Count, "D").End(xlUp).Row - 1, Cells(Rows.Count, "E").End(xlUp).Row - 1), 1).FormulaLocal = "=D2-E2"
Range("A1:R65000").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"A1:R65000").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
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


sauriez vous pourquoi à la premiere etape du TCD (ADD Field), VBA plante ?

En vous remerciant pour votre aide.
Donc le code que j'ai remis en bas te semble juste ? meme au niveau optimisation pr gérer jsutement le fait qu'il puisse avoir bcp de lignes ? Pour information, la macro (malgré la longueur) est allée au bout avec une base de 16 000 lignes, j'essaie de voir son maximum ....

Sinon sais tu pourquoi la macro met tout de meme un temps incroyablement long à faire des soustractions alors que manuellement sur excel cela est fait quasiment instantanément ?

En te remerciant.
Messages postés
24205
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 octobre 2021
6 937
Traiter 50000 lignes sera toujours plus long qu'en traiter 5, et ça dépend du processeur et de la mémoire disponible.
En plus tu traites des chaines c'est toujours gourmand.
eric
snif .. VBA c'est cool mais pour certaines taches il fait pas mieux qu'excel. les soustraction sur excel en manuel meme 65000 ligne ca donne la réponse instantanément. Pourquoi VBA qui fait la meme chose ne peut pas ....

En tout cas merci à toi et tout le temps consacré à mon soucis.
Messages postés
24205
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 octobre 2021
6 937
hi, sais tu à partir de quel moment je dois mettre le code de michel ?
Eric, j'ai placé l'application.screenupdating. Je pense que c'est peut etre un peu mieux mais ca reste tout de meme tres tres tres long. D'après toi le code que je place ne contient pas d'erreur ?

Sinon j'ai toujours l'erreur dès l'instruction add.fields row field ... je te place le code ci-dessous.

Sub CMCGR()
'
' CMCGR Macro
' Macro enregistrée le 10/01/2013 par b276573
'

'
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 lg, i As Long
With ActiveSheet.Range("D1:E65000")
lg = .Row + .Rows.Count - 1
End With
For i = lg To 2 Step -1
If Cells(i, "D") <> "" And Cells(i, "E") <> "" Then
Cells(i, "F").FormulaR1C1 = "=RC[-2]-RC[-1]"
End If
Next i
Application.ScreenUpdating = True
Range("A1:R65000").Select
Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"A1:R65000").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"

Cordialement
Messages postés
16527
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 octobre 2021
3 232
bonjour

Voici pour la partie longue à tester
Le code tcd n'aura pas d'influence sur la durée par rapport à un autre code à part la ligne Range ("A1:R65000") qui aurait méritée d'^tre réduite à la dernière ligne utilisée (cf variable derlig) si tu veux gagner du temps

Sub soustraire() 
Dim Derlig As Long, T_in(), T_out(), cptr As Long 
Dim Start As Single 

Start = Timer 
Application.ScreenUpdating = False 
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 
          If T_in(cptr, 2) <> "" Then T_out(cptr) = T_in(cptr, 1) - T_in(cptr, 2) 
Next 

Range("F2:F" & Derlig) = Application.Transpose(T_out) 
Application.ScreenUpdating = True 
MsgBox "durée : " & Timer - Start & " .sec" 

<code>Sub soustraire()  
Dim Derlig As Long, T_in(), T_out(), cptr As Long  
Dim Start As Single  

Start = Timer  
Application.ScreenUpdating = False  
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  
          If T_in(cptr, 2) <> "" Then T_out(cptr) = T_in(cptr, 1) - T_in(cptr, 2)  
Next  

Range("F2:F" & Derlig) = Application.Transpose(T_out)  
Application.ScreenUpdating = True  
MsgBox "durée : " & Timer - Start & " .sec"  
End If


Sans ton classeur je n'ai pu tester la macro

Excuses moi, Eric, je n'avais pas vu qu'il y avait déjà des réponses !!! :-/

Michel
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
Messages postés
24205
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 octobre 2021
6 937
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
aie .... le pirec'est que j'ai lu ton message ... en le relisant en fait je ne comprends pas trop. et j'ai cru que tu proposais de ne pas utiliser VBA. Le soucis est que je suis pas mal sur excel mais totalement débuant concernant VBA et la programmation en general. Désolé du coup ca complique les échanges. Je vais poster un extrait de la base à Eric. et sinon dis moi ce que je dois faire par rapport au message que tu m'avais dit. pr faire plus simple, je vais remettre le code que j'ai actuellement + un extrait de la base comme demandé par Eric. Pourras tu répondre directement sur ce message ? car je commence à me mélanger les pinceaux.
Messages postés
16527
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 octobre 2021
3 232
Bonjour

Je t'ai écris que ..."Sans ton classeur je n'ai pu tester la macro "... j'ai aussi 2007

Donc un extrait 3000 ou 4000 lignes de ton classeur serait le bienvenu

J'ai proposé la partie "chronophage" et non la partie TCD, cette dernière une fois réduit la surface par la recherche de la dernière ligne, n'avait que peu d'incidence sur la rapidité de la procédure

pour joindre une pièce
mettre le classeur sans données confidentielles en pièce jointe sur
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse

Messages postés
16527
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 octobre 2021
3 232
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.
Messages postés
16527
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 octobre 2021
3 232
moi non plus
Ce que je veux dire c'est que je debute sur VBA. j'ai utilisé l'enregistreur et depuis je bricole et tente de mettre les bouts de codes que vs m'indiquez. mais je ne sais pas encore maitriser la syntaxe de VBA. le code que j'ai ecrit est dc un mix entr ce que ja'vais corrigé de la partie que tu m'as indiqué. mais vu le ton message de tout à l'heure j'ai du me tromper en l'incluant. mais c'est surtout parceque je suis debutant dans VBA. j'ai meme acheté aujourd"hui "VBA pour les nuls" en esperant ne pas l'etre au point de ne pas comprendre ce livre ^^.
mais ce qu est sur c'est que le code que tu m'as transmis le 17 janv. 2013 à 17:34 fonctionnait sur vba 2003 (en enleveant qques terme qui resortait en erreur sur VBA). et que le meme fonctionnant sur VBA ne marche plus sur 2007. mais c'est peut etre une histoire de version de VBA. à moins quej'ai fait une erreur dans le dernier code que je t'ai transmis. J'ai fait tant de version que j'ai surement reussi à m'emméler les pinceaux. mais n'y vois pas de mauvaise volonté de ma part.
Bonjour Eric et Michel en cette journée enneignée,

Voici le lien pour un fichier exemple ( j'ai pris une base très limitée en ligne) : http://cjoint.com/?CAtmzYZLSLI


et voici le code que j'utilise actuellement sur vba 2007 et qui plante au niveau de la soustraction (à savoir que sur vba 2003 cela fonctionnait) :


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)
End If
Range("F2:F" & Derlig) = Application.Transpose(T_out)
Next cptr
Application.ScreenUpdating = True
Range("A1:R65000").Select
Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"A1:R65000").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

Cordialement