A voir également:
- Optimisation de code - condition if ... and
- Code ascii - Guide
- Optimisation pc - Accueil - Utilitaires
- Excel cellule couleur si condition texte - Guide
- Code de déverrouillage oublié - Guide
- Code puk bloqué - Guide
3 réponses
Bonjour,
Vous pouvez faire journee1 et 2 dans la meme boucle, si je ne m'abuse
Vous pouvez faire journee1 et 2 dans la meme boucle, si je ne m'abuse
Sub JourneeMoyenne2() Dim Tablo(143, 1) Dim P10() Dim deb, fin, A, Somme, Saison_1, Saison_2 Dim Heures(), Jour_1(), Jour_2(), Hiver(), Ete() Application.ScreenUpdating = False With Worksheets("Calcul") Saison_1 = .Range("I4") Saison_2 = .Range("J4") Jour_1 = .Range("I5:I11").Value Jour_2 = .Range("J5:J11").Value ReDim Heures(143) Heures = .Range("H13:H156").Value End With Hiver = Array(1, 2, 11, 12) Ete = Array(6, 7, 8, 9) With Worksheets("10min") Dim j As Long deb = .Range("pts_10_min").Row fin = .Range("pts_10_min").Cells(1, 1).End(xlDown).Row ReDim P10(fin - deb, 3) For j = 0 To UBound(P10) P10(j, 0) = .Range("C" & j + deb) 'heure P10(j, 1) = .Range("D" & j + deb) 'puissance P10(j, 2) = .Range("F" & j + deb) 'jour P10(j, 3) = .Range("G" & j + deb) 'mois Next j Dim i As Integer Dim s As Long A = 0: Somme = 0 A1 = 0: Somme1 = 0 Dim temps As Double FT = UBound(Tablo) - 1 For i = 0 To FT temps = Timer For s = deb To fin 'Journée moyenne 1 j = s - deb If P10(j, 0) = Heures(i + 1, 1) And Not IsError(Application.Match(P10(j, 2), Jour_1, 0)) Then If Saison_1 = "Année complète" Or _ (Saison_1 = "Hiver" And Not IsError(Application.Match(P10(j, 3), Hiver, 0))) Or _ (Saison_1 = "Eté" And Not IsError(Application.Match(P10(j, 3), Ete, 0))) Then Somme = Somme + P10(j, 1): A = A + 1 End If End If 'Journée moyenne 2 If .Range("C" & s) = Heures(i + 1, 1) And Not IsError(Application.Match(.Range("F" & s), Jour_2, 0)) Then If Saison_2 = "Année complète" Or _ (Saison_2 = "Hiver" And Not IsError(Application.Match(.Range("G" & s), Hiver, 0))) Or _ (Saison_2 = "Eté" And Not IsError(Application.Match(.Range("G" & s), Ete, 0))) Then Somme = Somme + .Range("D" & s): A = A + 1 End If End If Next s If Somme = 0 Or A = 0 Then Tablo(i, 0) = 0 Else Tablo(i, 0) = Somme / A If Somme1 = 0 Or A1 = 0 Then Tablo(i, 1) = 0 Else Tablo(i, 1) = Somme1 / A1 Debug.Print Timer - temps Next i End With 'Colle le tableau dans excel Worksheets("Calcul").Range("I13:J156") = Tablo Application.ScreenUpdating = True End Sub
Bonjour Sonoja,
bonjour F89
déjà commencer la macro par
gain de rapidité concernant P10
remplacer
par
'déclaration de P10 ---> dim P10 sans parenthèse
attention P10 de base 1 au lieu de base 0
je n'ai pas regardé après... cet aprem peut ^tre
bonjour F89
déjà commencer la macro par
application.screenupdating=False
'fige le défilement de l'écran: confort et rapidité
gain de rapidité concernant P10
remplacer
ReDim P10(Fin - deb, 3)
Dim j As Long
For j = 0 To UBound(P10)
P10(j, 0) = .Range("C" & j + deb) 'heure
P10(j, 1) = .Range("D" & j + deb) 'puissance
P10(j, 2) = .Range("F" & j + deb) 'jour
P10(j, 3) = .Range("G" & j + deb) 'mois
Next j
par
'déclaration de P10 ---> dim P10 sans parenthèse
P10 = .Range(.Cells(deb, "C"), .Cells(Fin, "G"))
attention P10 de base 1 au lieu de base 0
je n'ai pas regardé après... cet aprem peut ^tre
Bonjour merci de votre suggestion,
Cependant, je n'ai pas besoin des informations continues dans la colonne "E". C'est pour ça que j'avais choisi de remplir mon tableau avec une boucle "for".
J'avais essayé P10(,i)=.range... pour sélectionner les "colonnes" du tableau une par une. Mais ça ne fonctionne pas.
Ça n'est peut être pas la bonne syntaxe.
Cependant, je n'ai pas besoin des informations continues dans la colonne "E". C'est pour ça que j'avais choisi de remplir mon tableau avec une boucle "for".
J'avais essayé P10(,i)=.range... pour sélectionner les "colonnes" du tableau une par une. Mais ça ne fonctionne pas.
Ça n'est peut être pas la bonne syntaxe.
Bonjour tout le monde,
Une suggestion, toujours pour P10(), "volée" sur le site de Mr Boisgontier :
Transfert d'un champ discontinu dans un tableau
Très rapide, moins de 0.10 secondes pour 65 000 lignes.
Attention, au delà de 65 536 lignes cette méthode plante à cause de Application.Transpose!
Autre dégât collatéral d'Application.Transpose, il transforme toutes données en String.
Une suggestion, toujours pour P10(), "volée" sur le site de Mr Boisgontier :
Transfert d'un champ discontinu dans un tableau
Sub test() Dim Colonnes, Nb As Integer, dl As Long, i As Long, lig As Long, Col As Long Colonnes = Array(3, 4, 6, 7) ' colonnes C, D, F, G Nb = UBound(Colonnes) + 1 With Worksheets("10min") dl = derlig_reelle(.Cells) Dim P10(): ReDim P10(1 To Nb) For i = 1 To Nb P10(i) = .Cells(1, Colonnes(i - 1)).Resize(dl).Value Next i End With lig = 3: col = 4: MsgBox P10(col)(lig, 1) End Sub Private Function derlig_reelle(plage As Range) As Long If WorksheetFunction.CountA(plage) = 0 Then derlig_reelle = 1: Exit Function derlig_reelle = plage.Find("*", , , , , xlPrevious).Row End Function
Très rapide, moins de 0.10 secondes pour 65 000 lignes.
Attention, au delà de 65 536 lignes cette méthode plante à cause de Application.Transpose!
Autre dégât collatéral d'Application.Transpose, il transforme toutes données en String.
Désolé pour ma réponse tardive, je ne pensai pas recevoir de réponse de votre part aussi vite !
En effet, je n'avais pas pensé à regroupé les 2 journées dans la même boucle.
Ça me permet de gagner 0,03 sec en moyenne, c'est toujours quelques secondes de gagné au final !
Merci de votre aide en tout cas