Discussion :

[Log_polmed]

Rebonjour,

En cette belle journée,
Deux problemes sont nés,
Le premier fut résolu,
Quand le second fut perçu,
Le temps n'était plus allié,
Je m'y casse le nez,
Sur des secondes en années,
Et un cerveau en chantier.

(Chui nul en pseudo-poésie...)

Bref, j'ai un code qui traite une quantité énorme de lignes, en fait, elles se repartissent meme en deux feuilles, la premiere ne suffisant pas (en conclusion prés de 66000 lignes de tableau).

Je dois faire plusieurs choses sur ce tableau, en vue de construire un méga Tableau croisé dynamique.

Il me faut

pour chaque feuille
- Nommer les colonnes,

Pour chaque ligne (de chaque feuille)
- La supprimer si elle répond a certaines conditions
- Renommer une cellule
- Créer une nouvelle colonne
- Signer certains montants selon sa classe comptable.
- Inserer dans la colonne nouvellement créée une formule indigeste (qu'on m'a d'ailleurs, gentillement aidé à insérer)

End
End

- Trier

Le code donne ca :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
For i = 1 To Worksheets.count 
    'Interface d'execution de la preparation avant création
    Worksheets(i).Select
    Cells.Select
    Range("BE7").Activate
    Range("BN1") = "PRCTRUBR"
    Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
        False
 
    NbLignes = ActiveSheet.UsedRange.Rows.Count
 
 
    'Ligne par ligne
    For j = 2 To NbLignes
        'Supprime les contrats avec le préfixe "W", "X", "Y" ou "Z"
        'Supprime les Rubriques comprises dans l'intervalle [201;399]
 
        If Mid(Cells(j, 8).Value, 1, 1) = "W" Or Mid(Cells(j, 8).Value, 1, 1) = "X" Or Mid(Cells(j, 8).Value, 1, 1) = "Y" Or Mid(Cells(j, 8).Value, 1, 1) = "Z" Then
            Rows(j).Delete
        End If
 
        If Cells(j, 13) >= 201 And Cells(j, 13) <= 399 Then
            Rows(j).Delete
        End If
 
        'Change les noms de contrats qui n'ont pas "A" comme préfixe.
        If Cells(j, 8).Value <> "" Then
            Cells(j, 8).Value = "A" & Mid(Cells(j, 8).Value, 2, 4)
        End If
 
        'Signe le montant pour obtenir un solde juste
        classe = Mid(Cells(j, 7), 1, 1)
 
        If classe = "6" Then
            If Cells(j, 18).Value = "C" Then
                Cells(j, 50).Value = Cells(j, 50).Value * -1
            End If
        End If
 
        If classe = "4" Or classe = "7" Then
            If Cells(j, 18).Value = "D" Then
                Cells(j, 50).Value = Cells(j, 50).Value * -1
            End If
        End If
 
 
 
        'Insertion colonne avec formule pour calcul de % par Rubrique
        StrFormula = "=SI(SOMMEPROD(($M$1:M" & j - 1 & "=M" & j & ")*(T$1:T" & j - 1 & "=T" & j & "))=0;SOMMEPROD(($M$2:$M$" & NbLignes & "=M" & j & ")*($T$2:$T$" & NbLignes & "=T" & j & ");$AX$2:$AX$" & NbLignes & ")/SOMME.SI($M$2:$M$" & NbLignes & ";M" & j & ";$AX$2:$AX$" & NbLignes & ");" & Chr(34) & Chr(34) & ")"
        Cells(j, 66).FormulaLocal = StrFormula
 
    Next
 
            'Tri
        Cells.Select
        Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("M2") _
        , Order2:=xlAscending, Key3:=Range("T2"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
 
Next

Mais au lancement, mon ordi plante, car le temps d'execution est clairement trop loooooooong.

Si certains ont l'ame bricoleur, peuvent-il m'aider à accelerer le traitement, et le rendre le moins lourd possible ? Ma maitrise du VBA est trop faible pour y remedier seul.

[COCONUT2]

Evites les "select" car ça alourdi le déroulement de la macro et ca fait défiler la macro devant l'utilisateur

Code :

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

1
2
3
4
5
6
  Worksheets(i).Select
    Cells.Select
    Range("BE7").Activate
    Range("BN1") = "PRCTRUBR"
    Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
        False

peut etre avantageusement remplacé par

Code :

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

1
2
3
 Worksheets(i).Range("BE7").CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
        False
Range("BN1") = "PRCTRUBR"

Autre chose:
Lorsque dans tes macros, tu vas d'un onglet à l'autre, décris bien la cellule sur laquelle du travailles pour etre sur du résultat

Code :

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

Range("BN1") = "PRCTRUBR"

peut etre avantagé par:

Code :

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

Worksheets(i).Range("BN1") = "PRCTRUBR"

[mordrhim]

et si tu veux éviter que ton calsseur fasse "sapin de noël" utilise

Code :

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

1
2
3
4
5
Application.ScreenUpdating = False
 
'Là tu met ton code (le For i = 1 To Worksheets.count)
 
Application.ScreenUpdating = True

on dirait pas mais ca améliore l'execution du macro

[Log_polmed]

Merci merci !
J'ai appliqué vos conseils et les retiens pour la suite.

Mais le soucis vient de la concatenation et de l'insertion de la formule.

Y'a t-il des solutions de ce côté là ?