Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel boucle tres longue à executer

boucle tres longue à executer

3 réponses
Avatar
magic-dd
bonjour =E0 tous

sur une application que je suis en train de monter, grace =E0 l'aide de
beaucoup d'entre vous,

j'ai ce probleme qui se pose

j'importe des liste ( cela va tres vite)

apres cela se lance ma routine mais elle est tres longue

plus de 2 minutes pour 300 lignes

n'est il pas possible d'accelerer cela un peu car ce projet pourrait
marcher pour 2000 lignes

merci de m'aider

voici le code

Sub majdesdonnees()
Dim i As Integer
FIN =3D Application.CountA(Range("B:B"))
For i =3D 2 To FIN

grade =3D Range("b" & i)

Select Case grade
Case "AVT", "AV1", "CAL", "CLC", "avt", "av1", "cal",
"clc":
CAT =3D "MDR"
Case "SGT", "SGC", "ADJ", "ADC", "sgt", "sgc", "adj",
"adc", "MAJ", "maj":
CAT =3D "S/OFF"
Case "ASP", "SLT", "LTT", "CNE", "CDT", "LCL", "COL",
"AUM", "asp", "slt", "ltt", "cne", "cdt", "lcl", "col", "aum":
CAT =3D "OFF"
Case ""
CAT =3D ""
Case Else:
MsgBox "veuillez verifier le grade svp."
Range("b" & i) =3D ""
End Select
Range("AD" & i) =3D CAT

Dim Stx$, age%

date1 =3D Format(Cells(i, 5), "mm/dd/yyyy")
date2 =3D Format(Date, "mm/dd/yyyy")
Range("AE" & i) =3D Evaluate("DATEDIF(" & """" & date1 & """" &
"," & """" & date2 & """" & "," & """Y""" & ")")
age =3D Range("AE" & i)
Range("t" & i) =3D Evaluate("=3DIF(" & age & "< 39,""" & "SENIOR"
& """,IF(" & age & " > 49,""" & "V2" & """, """ & "V1" & """))")
Range("V" & i) =3D Evaluate("=3DIF(" & age & "<=3D 50,""" & "<50" &
""",IF(" & age & " > 50,""" & ">50" & """))")

VERIF_APTITUDE =3D Range("G" & i)

If VERIF_APTITUDE <> "INAPTE" And VERIF_APTITUDE <> "APTE"
Then

Range("H" & i) =3D VERIF_APTITUDE
Range("I" & i) =3D VERIF_APTITUDE
Range("J" & i) =3D VERIF_APTITUDE
Range("K" & i) =3D VERIF_APTITUDE
Range("L" & i) =3D VERIF_APTITUDE
Range("M" & i) =3D VERIF_APTITUDE
Range("N" & i) =3D VERIF_APTITUDE
Range("O" & i) =3D VERIF_APTITUDE
Range("P" & i) =3D VERIF_APTITUDE
Range("Q" & i) =3D VERIF_APTITUDE
Range("R" & i) =3D "NA"
End If

notef =3D Range("R" & i)
letbna =3D Range("AB" & i)
CAT =3D Range("AD" & i)
grade =3D Range("B" & i)
VERIF_APTITUDE =3D Range("G" & i)

Select Case VERIF_APTITUDE

Case "APTE"

Select Case CAT
Case "OFF"
letbna =3D "1"
CLT_POINTS =3D "0-20"
Case "S/OFF"
Select Case grade
Case "MAJ"
letbna =3D "-"
CLT_POINTS =3D "0-20"
End Select
letbna =3D "I"
CLT_POINTS =3D "0-20"
Case "MDR"
letbna =3D "I"
CLT_POINTS =3D "0-20"
End Select

Case INAPTE
letbna =3D "NA"
CLT_POINTS =3D ""
TOTAL_CCPM =3D "NA"
Case Else:
letbna =3D "NA"
CLT_POINTS =3D ""
TOTAL_CCPM =3D "NA"
End Select
Range("u" & i) =3D CLT_POINTS
Range("aB" & i) =3D letbna
Range("R" & i) =3D TOTAL_CCPM



' validation des grades
Range("b" & i) =3D UCase(Range("b" & i))

'validation de l'aptitude
Range("g" & i) =3D UCase(Range("g" & i))

'validation de l'age
Range("e" & i) =3D UCase(Range("e" & i))

'1ERE LETTRE DU PRENOM EN MAJUSCULE
Range("D" & i) =3D Application.Proper(Range("D" & i))

Next

End Sub
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Blaise Cacramp
Selon : Bonjour ou bonsoir

Commencer la routine par
Application.Calculation = xlCalculationManual ' =aucun recalcul pendant
la modification de la feuille

éventuellement application.visible = false quand la routine est au point :
plus rapide parce que pas gestion d'affichage

Terminer par
Application.Calculation = xlCalculationAutomatic

et application.visible = true



Cdt, Blaise
---- ---- ----


"magic-dd" a écrit dans le message de news:

bonjour à tous

sur une application que je suis en train de monter, grace à l'aide de
beaucoup d'entre vous,

j'ai ce probleme qui se pose

j'importe des liste ( cela va tres vite)

apres cela se lance ma routine mais elle est tres longue

plus de 2 minutes pour 300 lignes

n'est il pas possible d'accelerer cela un peu car ce projet pourrait
marcher pour 2000 lignes

merci de m'aider

voici le code

Sub majdesdonnees()
Dim i As Integer
FIN = Application.CountA(Range("B:B"))
For i = 2 To FIN

grade = Range("b" & i)

Select Case grade
Case "AVT", "AV1", "CAL", "CLC", "avt", "av1", "cal",
"clc":
CAT = "MDR"
Case "SGT", "SGC", "ADJ", "ADC", "sgt", "sgc", "adj",
"adc", "MAJ", "maj":
CAT = "S/OFF"
Case "ASP", "SLT", "LTT", "CNE", "CDT", "LCL", "COL",
"AUM", "asp", "slt", "ltt", "cne", "cdt", "lcl", "col", "aum":
CAT = "OFF"
Case ""
CAT = ""
Case Else:
MsgBox "veuillez verifier le grade svp."
Range("b" & i) = ""
End Select
Range("AD" & i) = CAT

Dim Stx$, age%

date1 = Format(Cells(i, 5), "mm/dd/yyyy")
date2 = Format(Date, "mm/dd/yyyy")
Range("AE" & i) = Evaluate("DATEDIF(" & """" & date1 & """" &
"," & """" & date2 & """" & "," & """Y""" & ")")
age = Range("AE" & i)
Range("t" & i) = Evaluate("=IF(" & age & "< 39,""" & "SENIOR"
& """,IF(" & age & " > 49,""" & "V2" & """, """ & "V1" & """))")
Range("V" & i) = Evaluate("=IF(" & age & "<= 50,""" & "<50" &
""",IF(" & age & " > 50,""" & ">50" & """))")

VERIF_APTITUDE = Range("G" & i)

If VERIF_APTITUDE <> "INAPTE" And VERIF_APTITUDE <> "APTE"
Then

Range("H" & i) = VERIF_APTITUDE
Range("I" & i) = VERIF_APTITUDE
Range("J" & i) = VERIF_APTITUDE
Range("K" & i) = VERIF_APTITUDE
Range("L" & i) = VERIF_APTITUDE
Range("M" & i) = VERIF_APTITUDE
Range("N" & i) = VERIF_APTITUDE
Range("O" & i) = VERIF_APTITUDE
Range("P" & i) = VERIF_APTITUDE
Range("Q" & i) = VERIF_APTITUDE
Range("R" & i) = "NA"
End If

notef = Range("R" & i)
letbna = Range("AB" & i)
CAT = Range("AD" & i)
grade = Range("B" & i)
VERIF_APTITUDE = Range("G" & i)

Select Case VERIF_APTITUDE

Case "APTE"

Select Case CAT
Case "OFF"
letbna = "1"
CLT_POINTS = "0-20"
Case "S/OFF"
Select Case grade
Case "MAJ"
letbna = "-"
CLT_POINTS = "0-20"
End Select
letbna = "I"
CLT_POINTS = "0-20"
Case "MDR"
letbna = "I"
CLT_POINTS = "0-20"
End Select

Case INAPTE
letbna = "NA"
CLT_POINTS = ""
TOTAL_CCPM = "NA"
Case Else:
letbna = "NA"
CLT_POINTS = ""
TOTAL_CCPM = "NA"
End Select
Range("u" & i) = CLT_POINTS
Range("aB" & i) = letbna
Range("R" & i) = TOTAL_CCPM



' validation des grades
Range("b" & i) = UCase(Range("b" & i))

'validation de l'aptitude
Range("g" & i) = UCase(Range("g" & i))

'validation de l'age
Range("e" & i) = UCase(Range("e" & i))

'1ERE LETTRE DU PRENOM EN MAJUSCULE
Range("D" & i) = Application.Proper(Range("D" & i))

Next

End Sub
Avatar
magic-dd
Merci blaise

cela se deroule en 5" maintenant

bravo pour cette astuce
Avatar
Blaise Cacramp
Selon : Bonjour ou bonsoir

Merci pour le retour. Mais je savais par expérience que le recalcul, qui ne
se voit pas vraiment quand on encode à la main, prend beaucoup de temps
quand c'est automatisé. Et le savais que la différence était spectaculaire.
Rendre le fichier invisible pendant sa fabrication, écarte aussi le danger
de voir l'utilisateur cliquer dedans et planter la routine.
C'est aussi un avantage si une question est posée à l'intérieur de la
routine.


Cdt, Blaise
---- ---- ----


"magic-dd" a écrit dans le message de news:

Merci blaise

cela se deroule en 5" maintenant

bravo pour cette astuce