Fichier tres lourd

bonjour, j'ai reussi a faire le fichier ci joint mais il est tres lourd et donc tres long a se mettre a jour .

peut etre y a t il une solution pour l'alleger ?

merci

Bonsoir,

Ton fichier contient, en Feuil2, 150 lignes avec des fonctions SOMMEPROD. Cette fonction est gourmande en ressources ... et tu l'utilises pour "scruter" des colonnes entières (soit plus d'un million de lignes), alors que les données de la Feuil1 ne se répartissent que sur +/- 300 lignes

Modifie tes formules pour travailler sur des plages de dimensions plus limitées, comme $C$1:$C$500, plutôt que $C:$C

Salut Sylvain, U.Milité,

bon, ben, désolé de saccager tout ton beau travail de formules!

Un double-clic en [A1] -"Boulier"- démarre la macro qui se trouve dans le module de la feuille 'VENT'.

Le résultat, après un temps infinitésimal, s'affiche en [Q:Q], en regard de ton tableau original.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim sWkDATA As Worksheet, sWkVENT As Worksheet
Dim tDATA, tVENT
Dim iFlag As Long, iIdx As Integer, iCol As Integer
'
Cancel = True
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
    Application.ScreenUpdating = False
    '
    Set sWkDATA = Worksheets("DATA")
    Set sWkVENT = Worksheets("VENT")
    '
    iRow = sWkDATA.Range("A" & Rows.Count).End(xlUp).Row
    tDATA = sWkDATA.Range("A1:I" & iRow).Value
    '
    With sWkVENT
        iRow = .Range("A" & Rows.Count).End(xlUp).Row
        For x = 1 To iRow
            If .Cells(x, 1) <> "" And IsNumeric(.Cells(x, 1)) Then
                iStart = x
                iStop = IIf(.Cells(x, 1).Offset(1, 0) <> "", .Range("A" & iStart).End(xlDown).Row, iStart)
                tVENT = .Range("D" & iStart & ":O" & iStop).Value
                '
                iCol = 0
                For y = iStart To iStop
                    iCol = iCol + 1
                    iFlag = .Cells(y, 1)
                    For Z = 1 To UBound(tDATA, 1)
                        If tDATA(Z, 1) = iFlag Then
                            iIdx = Choose(Month(CDate(tDATA(Z, 3))), 5, 6, 7, 8, 9, 10, 11, 12, 13, 1, 2, 3, 4)
                            tVENT(iCol, iIdx) = tVENT(iCol, iIdx) + tDATA(Z, 9)
                        Else
                            Exit For
                        End If
                    Next
                Next
                .Range("Q" & iStart).Resize(UBound(tVENT, 1), UBound(tVENT, 2)).Value = tVENT
                x = iStop
            End If
        Next
    End With
    '
    Application.ScreenUpdating = True
End If
'
Set tDATA = Nothing
Set tVENT = Nothing
'
End Sub

Si le calcul te convient, afin d'afficher les résultats au bon endroit, il faut changer cette ligne-ci, en fin de macro.

.Range("Q" & iStart).Resize(UBound(tVENT, 1), UBound(tVENT, 2)).Value = tVENT

vers...

.Range("D" & iStart).Resize(UBound(tVENT, 1), UBound(tVENT, 2)).Value = tVENT

A+

Bonjour tout le monde,

Pour le plaisir, encore plus rapide : Timer = 0,008

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim sWkDATA As Worksheet, sWkVENT As Worksheet
Dim tDATA, tVENT, tNUM
Dim iFlag As Long, iIdx As Integer, iCol As Integer
'
Cancel = True
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
    Application.ScreenUpdating = False
    '
    Set sWkDATA = Worksheets("DATA")
    Set sWkVENT = Worksheets("VENT")
    '
    iRow = sWkDATA.Range("A" & Rows.Count).End(xlUp).Row
    tDATA = sWkDATA.Range("A1:I" & iRow + 1).Value
    '
    With sWkVENT
        iRow = .Range("A" & Rows.Count).End(xlUp).Row
        tNUM = sWkVENT.Range("A1:A" & iRow).Value
        For x = 1 To UBound(tNUM, 1)
            If tNUM(x, 1) <> "" And IsNumeric(tNUM(x, 1)) Then
                iStart = x
                iStop = IIf(tNUM(x + 1, 1) <> "", .Range("A" & iStart).End(xlDown).Row, iStart)
                tVENT = .Range("D" & iStart & ":O" & iStop).Value
                '
                iCol = 0
                For y = iStart To iStop
                    iCol = iCol + 1
                    iFlag = tNUM(y, 1)
                    For Z = 1 To UBound(tDATA, 1)
                        If tDATA(Z, 1) = iFlag Then
                            iIdx = Choose(Month(CDate(tDATA(Z, 3))), 5, 6, 7, 8, 9, 10, 11, 12, 13, 1, 2, 3, 4)
                            tVENT(iCol, iIdx) = CDbl(tVENT(iCol, iIdx)) + CDbl(tDATA(Z, 9))
                        Else
                            Exit For
                        End If
                    Next
                Next
                .Range("Q" & iStart).Resize(UBound(tVENT, 1), UBound(tVENT, 2)).Value = tVENT
                x = iStop
            End If
        Next
    End With
    '
    Application.ScreenUpdating = True
End If
'
Set tDATA = Nothing
Set tVENT = Nothing
Set tNUM = Nothing
'
End Sub

A+

19tresosylvain.xlsm (67.05 Ko)

Bonjour,

Merci a vous .

Je vais tester cela ce matin.

Cdty

bonjour U.Milité,

lorsque je remplace $C:$C par $C$1:$C$500 dans mon tableau , le resultat est N/A.

as tu une idée du probleme ?

merci curulis57 pour le fichier que tu as fait mais j'aimerais si possible rester sur un fichier que je pourrais par la suite modifier moi meme.

cdt

Salut Sylvain,

modifier dans quel sens?

Toute macro peut s'adapter dès que l'on connaît les règles!

Mais, soit...

Bon travail!

A+

justement , la est mon probleme , je ne connais pas les regles.

merci

Bonsoir SYLVAIN91,

Salut curulis57,

Désolé, je n'ai pas pu me connecter plus tôt

Dans ton fichier, j'ai activé le calcul manuel (dans les options) et j'ai modifié une de tes formules en limitant la taille de la plage aux lignes de 1 à 500 ... je n'ai pas de N/A! dans les résultats?

En O4, la formule devient

=SOMMEPROD((Feuil1!$C$1:$C$500>=DATEVAL("01/08/2017"))*((Feuil1!$C$1:$C$500<=DATEVAL("31/08/2017"))*(Feuil1!$A$1:$A$500=$A4)*Feuil1!$I$1:$I$500))

j'ai recopié jusqu'en O16 et j'ai les mêmes résultats que les tiens!

Attention: pour la fonction SOMMEPROD (comme d'autres) la taille des plages dans la formule doivent être identiques (voir les plages surlignées dans la formule ci-dessus) ... ne serait-ce pas là l'origine de tes N/A! ??

Bonsoir, pas de soucis pour le délai de réponse.

Sûrement le problème des paramètres identiques.

Je vais voir demain.

Merci

bonjour ,

merci curulis57 , cela fonctionne tres bien et surtout bien plus vite.

cdt

Rechercher des sujets similaires à "fichier tres lourd"