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+
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