VBA : faire une soustraction rapide de deux colonnes

Version imprimable

1 pièce(s) jointe(s)

Bonsoir,

J'aurais besoin de réaliser un code sur une base de données qui peut être très importante (du style 50 000 lignes). J'ai des sommes sur la colonne D ainsi que sur la colonne E. Je voudrais faire la soustraction D-E sur la colonne F et ce sur chaque ligne.

Mais il faudrait que VBA applique cette soustraction quelque soit le nombre de lignes, sans toucher à la cellule d’entête "F1" et jusqu'à ce qu'il y ait des valeurs sur la colonne D ou E.

Avec l'enregistreur de macro et ce que j'ai trouvé sur internet j'ai pu realisé ce code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 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]" Next i End Sub
Cela fonctionne pour des bases allant de quelques lignes à quelques milliers. Mais quand la base devient plus important les remplacements et les soustractions sont très très longues à se réaliser, ce qui rend caduque l'utilité de la macro.

Auriez vous une idée pour que ces actions se fassent beaucoup plus rapidement ?

En vous remerciant

En utilisant une variable tableau

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Traiter()
Dim LastLig As Long, i As Long
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets(1)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("A1:F" & LastLig)
    Tb(1, 6) = "Montant soldé"
    For i = 2 To LastLig
        Tb(i, 6) = Tb(i, 4) - Tb(i, 5)
    Next i
    .Range("A1:F" & LastLig) = Tb
End With
End Sub

Bonsoir mercatog,

Tout d'abord merci beaucoup et desolé de répondre aussi tard mais je n'ai pas reçu de mail notifiant votre réponse et l'ai vue en allant par hasard sur mon ancien post.

J'ai testé votre code et il fonctionne bien. Pour 2000 lignes c'est quasi instantané. J'ai testé avec 50 000 lignes et là ca a mis 3min. Ce qui est un peu long mais plus rapide que ce que j'avais déjà obtenu.

Etant novice sur VBA, pourriez vous me dire pourquoi VBA met 3min à faire une action que excel (en manuel) fait quasiment instantanément ? (meme si en toute logique traiter 50 000 lignes est forcément plus long que traiter 100 lignes)

J'aurais une autre question par la suite mais pour ne pas que ce soit brouillon je vous la poserai par la suite.

En vous remerciant. Je vous place mon code modifié pour une vue d'ensemble :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 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" With Worksheets(1) LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row Tb = .Range("A1:F" & LastLig) Tb(1, 6) = "Montant soldé" For i = 2 To LastLig Tb(i, 6) = Tb(i, 4) - Tb(i, 5) Next i .Range("A1:F" & LastLig) = Tb End With Application.ScreenUpdating = True Application.DisplayAlerts = False 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 soldé") .Orientation = xlDataField End With

Re teste la macro TELLE sur ton fichier (n'y ajoute rien)
Chez moi 65000 lignes traités en 0.6 secondes (Sans la partie réservée à la création du TCD)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Traitement()
Dim LastLig As Long, i As Long, T As Long
Dim Tb
 
T = Timer
Application.ScreenUpdating = False
With Worksheets(1)
    .Columns(6).Insert
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("A1:F" & LastLig)
    Tb(1, 6) = "Montant soldé"
    For i = 2 To LastLig
        Tb(i, 6) = Tb(i, 4) - Tb(i, 5)
    Next i
    .Range("A1:F" & LastLig) = Tb
End With
MsgBox "Exécution en " & Timer - T & " secondes"
End Sub

21/01/2013, 11h11
yanou91

Bonjour,

je vous remercie pour votre réponse. au depart votre macro ne fonctionnait pas (erreur incompatibilité de Type). J'ai compris ensuite que c'etait parce que sur la base initiale, les nombres sont inscrits avec des points et non avec des virgules ce qui genait apparament votre code. Les remplacements faits, j'ai testé votre macro qui a mis 4.1 secondes. Je suis au travail et le PC est plus lent (comparé à vos 0.6 seconde car dans l'absolu 4 secondes c'est génial).

En tout vous aviez raison et je m'aperçois que mon analyse etait mauvaise. Ce qui prend du temps c'est le remplacement des "." par des "," dans les nombres (la base comptable sort ainsi et je dois passer en virgule pour travailler ces données).

avez vous une solution pour que mon code remplace les points par des virgules aussi rapidement qu'il réalise les soustraction ou dumoins dans un temps raisonnable ?

En vous remerciant

Essaies ceci, le remplacement est fait dans la variable tableau et non sur la feuille Excel.
Ne t'en fais pas du contenu du Replace (On remplace le point par la séparateur décimal de vba (.))

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Traitement()
Dim LastLig As Long, i As Long, T As Long
Dim Tb
 
T = Timer
Application.ScreenUpdating = False
With Worksheets(1)
    .Columns(6).Insert
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("D1:F" & LastLig)
    Tb(1, 3) = "Montant soldé"
    For i = 2 To LastLig
        Tb(i, 1) = Replace(Tb(i, 1), ".", ".")
        Tb(i, 2) = Replace(Tb(i, 2), ".", ".")
        Tb(i, 3) = Val(Tb(i, 1)) - Val(Tb(i, 2))
    Next i
    .Range("D1:F" & LastLig) = Tb
End With
MsgBox "Exécution en " & Timer - T & " secondes"
End Sub

Impressionant ! merci beaucoup. j'ai acheté "VBA pour les nuls" et je commence tout juste. Car là j'ai recopié votre code mais je suis pas capable de comprendre la différence entre ce que vous appelez le calcul "dans la table" et "dans la feuill". Mais la différence est palpante.

Une derniere chose, si cele est possible, pourriez vous me conseillez sur le TCD dont j'ai mis un extract qui pose probleme ?

Je m'explique. A la maison, excel est rapide et le TCD VBA s'enchaine jusqu'au bout sans probleme. Au travail, le TCD VBA s'achève sans probleme pour peu de lignes, mais pour un grand nombre de lignes il bloque sur le 6eme champ de ligne ajouté ... Je pense que c'est une histoire de mémoire ou de ressources (mais je ne maitrise pas cela). Sachan que que manuellement via excel je peux aller jusqu'à 8 champs de ligne sans soucis sur ce meme ordinateur.

Ma macro TCD VBA initiale demandait l'ajout de tous les champs de ligne "Row fields" en meme temps (sur une seule ligne d'instruction). Je me suis donc dit que c'etait trop pour VBA et Excel et j'ai eu l'idée de décomposé le code pour ajouter rowfiels par rowfield.
Malheureusement il bloque apres le 5e ou le 6e champ. Auriez vous une idée ?
Un grand merci dans tous les cas car vous m'avez déjà énormément aidé.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 Application.ScreenUpdating = False With Worksheets(1) .Columns(6).Insert Range("F1").Select ActiveCell.FormulaR1C1 = "Montant solde" LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row Tb = .Range("D1:F" & LastLig) Tb(1, 3) = "Montant solde" For i = 2 To LastLig Tb(i, 1) = Replace(Tb(i, 1), ".", ".") Tb(i, 2) = Replace(Tb(i, 2), ".", ".") Tb(i, 3) = Val(Tb(i, 1)) - Val(Tb(i, 2)) Next i .Range("D1:F" & LastLig) = Tb End With Application.ScreenUpdating = True Application.DisplayAlerts = False 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 With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("CGR A") .Orientation = xlRowField: .Position = 1: End With With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Poste") .Orientation = xlRowField: .Position = 2: End With With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Libellé réduit du compte") .Orientation = xlRowField: .Position = 3: End With With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Libellé écriture") .Orientation = xlRowField: .Position = 4: End With With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Date Compt") .Orientation = xlRowField: .Position = 5: End With With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Pièce") .Orientation = xlRowField: .Position = 6: End With With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Ets") .Orientation = xlRowField: .Position = 7: End With With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _ "Montant solde") .Orientation = xlDataField End With

21/01/2013, 14h41
mercatog
Une première remarque. pourquoi tu as ajouté ces 2 lignes (elles ne sont pas nécessaires)
Code:

1 2 Range("F1").Select ActiveCell.FormulaR1C1 = "Montant solde"
Une seconde remarque, pourquoi ne pas se pencher sur access qui est plus souple dans le traitement de trop grandes données.
21/01/2013, 18h43
yanou91

Bonsoir,

Désolé pour le temps de réponse j'etais en réunion toute l'apres midi ...

Pour répondre à la question : Les données sont prises d'un ERP et extraite via Excel. Apres j'envoie des tableaux par excel à pas mal de managers qui eux utilisent excel. Je ne sais meme pas s'il connaissent ACCES et pourront l'ouvrir. En tout cas culturellement tous les échanges se font via Excel. Donc il est vrai que j'essaie dorénavant de me faire plein de macro pour automatiser les taches "répétitives" qui me servent à faire tous ces tableaux. Excel m'a semblé la logique. Mais il est vrai que quand j'etais etudiant et pour un stage j'avais atteint un bon niveau sur ACCES, malheureusement j'ai vu que ca me servait aps et qu'en gestion et finance partout où j'allais excel regne en maitre. Avec le temps j'ai perdu l'habitude et ma "compétence" sur ACCES. Acces peut surement faire de belles choses mais je me dois de rester sur Excel car ce dernier est l'outil unique de communication dans l'entreprise.

Je me demandais si dans le code TCD de ma macro s'il y avait pas des choses à améliorer pour moins saturer la mémoire du poste au bureau qui est plus léger que celui à mon domicile ? C'est frustrant de voir excel en manuel reussir à mettre tous ces champs sans soucis et de voir VBA échouer. Alors que VBA a tellement de possibilité.

Je vous remercie en tout cas pour toute votre aide
21/01/2013, 18h55
yanou91

Je me repete, désolé, mais merci beaucoup car je viens de tester la macro à chez moi là. Et tout marche en 15 secondes et pourtant j'ai mis 54 000 lignes.

il me reste à voir comment faire la meme chose sur le poste du boulot où apparament VBA et/ou le poste informatique est moins puissant, ce qui fait plantée la macro à partir de l'ajout du 6e champs de ligne :cry: .