Discussion :

[yanou91]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mercatog]

En utilisant une variable tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[yanou91]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mercatog]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[mercatog]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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