Ecriture multiple dans cellule

Version imprimable

1 pièce(s) jointe(s)

Bonjour, je cherche à optimiser un code qui me prends près d'une heure à exécuter

Il s'agit de multiples boucles dans lesquels s'effectuent des calculs.
J'ai identifié le bout de code qui me posait problème : L'écriture du résultat de la macro dans les cellules. Voici bout de code modifié pour le besoins :

Voici le fichier d'exemple : Pièce jointe 143877

Et voici le code, si cela est suffisant :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub EcriredansCell() Dim TablEssai Dim i As Integer, j As Integer Dim sw As StopWatch Set sw = New StopWatch sw.StartTimer For i = 1 To 50 TablEssai = Array(Int((20 * Rnd) + 1), Int((40 * Rnd) + 1), Int((60 * Rnd) + 1), Int((80 * Rnd) + 1), Int((100 * Rnd) + 1)) For j = LBound(TablEssai) To UBound(TablEssai) Range("A1").Offset(i, j).Value = TablEssai(j) Next j Next i Debug.Print "Ce code s'exécute en : " & sw.EndTimer & "milliseconds" End Sub
Pour mesurer la durée d'exécution : il faut 50 millisecondes au code pour s'exécuter.
Le problème, c'est que mon tableau fait 2000 lignes et 60 colonnes, avec des formules, etc, et il lui faut, pour cet exemple de 50 lignes : 42 secondes... Et même en utilisant le fichier d'exemple, lorsque le fichier original (9Mo) est ouvert, cela prends 42 secondes. Je pense donc que c'est un problème de ressource PC.

Le fichier original contiens des données confidentielles que je ne peux pas partager, mais je cherche un moyen d'écrire moins souvent dans les cases, peut-être en copiant les données lignes par ligne (5 à la fois) ? Cependant, je ne connais pas le code...

PS : Je précise que

Code:

Application.ScreenUpdate = False

ne modifie pas la durée d'exécution.

Merci de votre aide.

Korleone.

24/04/2014, 12h04
SfJ5Rpw8

bonjour,

ton classeur contient-il des formules de calcul ? si oui passe en calcul Manuel ..et fait un essai...

Une proposition

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
Sub EcriredansCell()
Dim NbLig As Long, i As Long
Dim NbEss As Integer, j As Integer
Dim TablEssai() As Integer
 
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
 
NbLig = 50
NbEss = 5
 
ReDim TablEssai(1 To NbLig, 1 To NbEss)
For j = 1 To NbEss
    For i = 1 To NbLig
        TablEssai(i, j) = Int((20 * j * Rnd) + 1)
    Next i
Next j
 
'Ici on transfère le tableau TablEssai en une seule fois
Feuil1.Range("A1").Resize(NbLig, NbEss) = TablEssai
 
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

24/04/2014, 13h25
Korleone
Merci à Bbill et à mercatog pour votre aide.

J'ai passé le calcul en manuel, et ça m'a fait gagné un temps fou !
Sur mon fichier final, je passe de 2800 secondes (46 minutes) à 7 secondes !

Si j'osais, je dirais que je vous aime ;-)
Du coup, j'ai uniquement appliqué
Code:

1 2 3 Application.Calculation = xlCalculationManual Application.Calculation = xlCalculationAutomatic
Je garde en réserve le code de mercatog, qui m'a appris une méthode que je ne connaissait pas.
Je vous suis super reconnaissant. Imaginez le temps que vous m'avez fait gagné en 2 lignes de code !