boucle tres longue à executer

Le
magic-dd
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Blaise Cacramp
Le #20549531
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"
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
magic-dd
Le #20550001
Merci blaise

cela se deroule en 5" maintenant

bravo pour cette astuce
Blaise Cacramp
Le #20553351
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"
Merci blaise

cela se deroule en 5" maintenant

bravo pour cette astuce


Publicité
Poster une réponse
Anonyme