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 15 mars 2023 - 1 avril 2016 à 20:47
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 15 mars 2023 - 1 avril 2016 à 20:47
A voir également:
- Optimisation de code - condition if ... and
- Reboot and select proper boot device - Forum Windows
- Code asci - Guide
- Excel condition couleur - Guide
- Code 80072efe ✓ - Forum Windows
- Freewifi secure code ✓ - Forum Réseau
3 réponses
f894009
Messages postés
16904
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 mars 2023
1 678
23 mars 2016 à 11:40
23 mars 2016 à 11:40
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
michel_m
Messages postés
16593
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
7 mars 2023
3 291
29 mars 2016 à 12:21
29 mars 2016 à 12:21
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
f894009
Messages postés
16904
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 mars 2023
1 678
29 mars 2016 à 13:37
29 mars 2016 à 13:37
Bonjour,
En effet si Tableau P10() un peu long, vaut mieux passer par votre code
En effet si Tableau P10() un peu long, vaut mieux passer par votre code
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
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.
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.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
>
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
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
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.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
1 avril 2016 à 20:47
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.
Cela permet, au final, de regagner 5-6 secondes au total...
Mieux que rien.
Si vous êtes intéressé, faites le nous savoir.
29 mars 2016 à 12:02
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