Optimisation de code - condition if ... and

Fermé
sonoja Messages postés 19 Date d'inscription jeudi 5 juin 2014 Statut Membre Dernière intervention 14 février 2017 - 23 mars 2016 à 10:17
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 1 avril 2016 à 20:47
Bonjour,

J'aimerai améliorer la rapidité d'exécution de mon code.

Pour mettre un peu de contexte je veux réaliser une journée type "moyenne" de 24h à partir de courbes de charge électriques sur une année. Les critères sont les jours de la semaine (lundi ? mardi ? ...) et la saison (hiver, été)
Je veux 2 journées types différentes.

Je fais donc une sorte de moyenne, sur de très nombreuses conditions. et la structure classique de MOYENNE.SI.ENS d'excel de me permet pas d'y arriver. J'ai donc décider d'essayer par une macro.

L'idée générale est de repérer les cellules correspondants à mes critères, puis de les sommer et de diviser cette somme par le nombre de cellules. Je fais donc une moyenne arithmétique "a la mano".

Je fais 2 boucles "for" imbriquées (une sur 52000 cellules et l'autre sur 144 cellules) au total j'ai donc un grand nombre d'opérations à faire, et le moindre dixième de seconde gagné est très important.

A l'intérieur de mes boucles for, j'ai de nombreuses conditions "IF", et j'utilise les structures IF... AND


Pouvez-vous me dire s'il y a un moyen d'optimiser cette méthode ? Ou si le code en lui-même peut être optimisé (par exemple j'ai lu qu'en déclarant les variables utilisées dans mes boucles "for", on gagne un peu de temps)

Merci d'avance !!

Ci-dessous le code en question




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()


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")

deb = .Range("pts_10_min").Row
fin = .Range("pts_10_min").Cells(1, 1).End(xlDown).Row

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

Dim i As Integer
Dim s As Long

'Journée moyenne 1
A = 0
Somme = 0

Dim temps As Double


For i = 0 To UBound(Tablo) - 1
temps = Timer
For s = deb To fin
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
Next s

If Somme = 0 Or A = 0 Then
Tablo(i, 0) = 0
Else
Tablo(i, 0) = Somme / A
End If
Debug.Print Timer - temps
Next i

'Journée moyenne 2
A = 0
Somme = 0

For i = 0 To UBound(Tablo) - 1
For s = deb To fin
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, 1) = 0
Else
Tablo(i, 1) = Somme / A
End If

Next i

End With

'Colle le tableau dans excel
Worksheets("Calcul").Range("I13:J156") = Tablo

End Sub



A voir également:

3 réponses

f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713
23 mars 2016 à 11:40
Bonjour,

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
0
sonoja Messages postés 19 Date d'inscription jeudi 5 juin 2014 Statut Membre Dernière intervention 14 février 2017
29 mars 2016 à 12:02
Bonjour,

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
0
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
29 mars 2016 à 12:21
Bonjour Sonoja,
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


0
f894009 Messages postés 17268 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 29 mars 2025 1 713
29 mars 2016 à 13:37
Bonjour,

En effet si Tableau P10() un peu long, vaut mieux passer par votre code
0
sonoja Messages postés 19 Date d'inscription jeudi 5 juin 2014 Statut Membre Dernière intervention 14 février 2017
1 avril 2016 à 12:13
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.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 757 > sonoja Messages postés 19 Date d'inscription jeudi 5 juin 2014 Statut Membre Dernière intervention 14 février 2017
1 avril 2016 à 12:48
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

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.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 757
1 avril 2016 à 20:47
Il convient également de remplacer Application.Match par une autre méthode.
Cela permet, au final, de regagner 5-6 secondes au total...

Mieux que rien.
Si vous êtes intéressé, faites le nous savoir.
0