Acceleration grace à VBA ?

man95 · 20 Janvier 2009

Bonjour à vous tous

je viens vers vers vous car j'ai un petit problème que je n'arrive pas à résolver

Voilà, j'aimerai au lieu de créer par VBA une formule "SommeProd" dans mes cellules, plutôt inscrire simplement le résultat et ceci afin d'accélérer le code de ma macro tres long malgré le fichier joint divisé par 2)

afin d'etre le plus clair possible la procédure crée dans chaque cellule une formule sommeprod (AA6:AR6)
puis fait un copier glisser de X lignes suivant le nombre de cellule renseignées en AA

Ci joint un fichier qui sera plus explicite

Merci de vos réponses ou idées

MAN

porcinet82 · 20 Janvier 2009

Re : Acceleration grace à VBA ?

Salut,

Je t'aurai bien aidé a adapter, mais je ne sais pas à quoi sert cette formule.
Cependant, j'ai regardé ton code et je me permet quelques remarques. Tu utilises plusieurs fois Application.ScreenUpdating = False alors qu'un seul au début du code suffirai. De plus, il faut penser à les remettre à True à la fin (idem pour Application.DisplayAlerts = False à remettre à True à la fin).
Une autre remarque qui je te ferai gagner du temps, pourquoi ne pas appliquer la formule seulement sur la plage de données (en récupérant la dernière ligne utilisées) et non sur toutes les lignes..

@+

man95 · 20 Janvier 2009

Re : Acceleration grace à VBA ?

salut porcinet 82

Merci de ton aide pour l'amelioration de mon code. Par contre je ne comprends pas comment faire pour mettre en place ta derniere suggestion

"Une autre remarque qui je te ferai gagner du temps, pourquoi ne pas appliquer la formule seulement sur la plage de données (en récupérant la dernière ligne utilisées) et non sur toutes les lignes..."

Sachant que chaque formule est unique à la cellule.

Merci à toi et à vous tous pour vos aides et solutions

MAN

man95 · 20 Janvier 2009

Re : Acceleration grace à VBA ?

Re bonjour a vous tous

ne voyant aucune idée revenir je me permet de relancer mon post

peut etre que ma demande est infaisable après tout !

merci d'avance de votre retour

porcinet82 · 20 Janvier 2009

Re : Acceleration grace à VBA ?

re,

Attend un peu !!
Je suis désolé, mais je travail également, donc laisse moi un peu de temps pour te répondre... J'essais de regarder ca demain dans la matinée.
Par contre au passage, tu aurais pu mettre quelques explications concernant les formules utilisées, peut etre qu'il sera aussi simple de faire un code que de coller tes formules.

@+

skoobi · 20 Janvier 2009

Re : Acceleration grace à VBA ?

Bonjour man95,
porcinet82 🙂,

comme te l'a suggéré porcinet, voici le code modifié en prenant en compte la dernière ligne du tableau plutôt que celle de la feuille (voir en bleu):

Code:

Sub MaJ()
'

'Récupere une liste sans doublon de la colonne A:A
'et copie cette liste à partir de la cellule AA6
    Dim I As Long, t, z As Variant, L As Object

On Error Resume Next
Application.ScreenUpdating = False
Set L = CreateObject("Scripting.Dictionary")
t = Range("A1:A" & Range("A65536").End(xlUp).Row)
For I = LBound(t) To UBound(t)
L.Add t(I + 1, 1), t(I + 1, 1): Next
[AA5] = "Métier"


For Each z In L
Range("AA65536").End(xlUp).Offset(1, 0).Value = z
Next
    
'compte le nombre de cellule non vide en colonne ("AA:AA")
'en vue de la copie des formules dans le tableau ("AA6:AS")
    Dim nblignes As Long
    Dim X As Long
    Dim Taille As Long
    
    Application.DisplayAlerts = False
    [COLOR=Blue][B]
    DerLig = Worksheets("Bilan").Range("A65536").End(xlUp).Row[/B][/COLOR]
    nblignes = Worksheets("Bilan").Range("AA10:AA2000").CurrentRegion.Rows.Count
    Taille = 3 + nblignes
    
For X = 6 To Taille
        
'copie des formules Sommeprod sur la 1ere ligne ("AA6:AS6")
    Range("AB6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R[COLOR=Blue][B]" & DerLig & "[/B][/COLOR]C1=RC27)*(R2C4:R[B][COLOR=Blue]" & DerLig & "[/COLOR][/B]C4=R4C)*(R2C2:R" & DerLig & "C2))"
    
    Range("AC6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C[-1])*(R2C3:R" & DerLig & "C3))"
        
    Range("AE6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C)*(R2C2:R" & DerLig & "C2))"
    
    Range("AF6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C[-1])*(R2C3:R" & DerLig & "C3))"
    
    Range("AH6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C)*(R2C2:R" & DerLig & "C2))"
    
    Range("AI6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C[-1])*(R2C3:R" & DerLig & "C3))"
    
    Range("AK6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C)*(R2C2:R" & DerLig & "C2))"
    
    Range("AL6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C[-1])*(R2C3:R" & DerLig & "C3))"
    
    Range("AN6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C)*(R2C2:R" & DerLig & "C2))"
    
    Range("AO6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C[-1])*(R2C3:R" & DerLig & "C3))"
    
    Range("AQ6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C)*(R2C2:R" & DerLig & "C2))"
    
    Range("AR6").FormulaR1C1 = _
        "=SUMPRODUCT((R2C1:R" & DerLig & "C1=RC27)*(R2C4:R" & DerLig & "C4=R4C[-1])*(R2C3:R" & DerLig & "C3))"
        
    Range("AB6:BK6").AutoFill Destination:=Range("AB6:BK" & Taille), Type:=xlFillDefault

Next X

    Application.DisplayAlerts = True

    
End Sub

Edit: J'ai enlevé les Select, inutilent ici.

skoobi · 20 Janvier 2009

Re : Acceleration grace à VBA ?

Encore moi,

j'ai vu que tu utilises mal l'objet Dictionary.Voici la bonne façon de faire.
La raison du On Error Resume Next je suppose. C'est pas très malin car si une autre erreur peut se produire plus loin dans le code, cette erreur sera zappé et la macro continura...

Code:

....
.....
Set L = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
t = Range("A1:A" & Range("A65536").End(xlUp).Row)
For I = LBound(t)[COLOR=Blue][B] + 1[/B][/COLOR] To UBound(t)
[B][COLOR=Blue]  If Not L.exists(t(I, 1)) Then L.Add t(I, 1), t(I, 1)
Next[/COLOR][/B]
[AA5] = "Métier"
.....
..........

Néanmoins, si tu comptes utiliser la gestion d'erreur, il faut associer la ligne que tu as mise avec On Error Goto 0 comme ceci:

Code:

On Error Resume Next
'ici la partie du code pour lequel tu veux gérer l'erreur
On Error Goto 0

On Error Goto 0 permet de réinitialiser la gestion des erreurs c'est à dire que si une erreur quelconque se produit après cette ligne, l'erreur est signalé et la macro stoppée.

man95 · 20 Janvier 2009

Re : Acceleration grace à VBA ?

Porcinet82,Skoobi,

Merci de vos réponses

Porcinet82, désolé d'avoir montré trop d'impatience, mais je pensais que ma demande était tombée aux oubliettes... Bien entendu j'attendrai le temps qu'il faudra pour avoir des réponses.

Skooby, merci beaucoup pour la correction de mon code ainsi que les explications qu'il l'accompagne.

Je suis peu à l'aise avec le VBA et grace à la recherche dans le forum, j'essai de construire (plus ou moins bien!) quelques procédures.

Merci encore

Man

Acceleration grace à VBA ?

man95

XLDnaute Occasionnel

Pièces jointes

porcinet82

XLDnaute Barbatruc

man95

XLDnaute Occasionnel

man95

XLDnaute Occasionnel

porcinet82

XLDnaute Barbatruc

skoobi

XLDnaute Barbatruc

skoobi

XLDnaute Barbatruc

man95

XLDnaute Occasionnel

Discussions similaires

Acceleration grace à VBA ?

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency