Accelerer code vb
cs_seeb
Messages postés
3
Date d'inscription
samedi 17 novembre 2007
Statut
Membre
Dernière intervention
17 novembre 2007
-
17 nov. 2007 à 09:05
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 18 nov. 2007 à 15:33
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 18 nov. 2007 à 15:33
4 réponses
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
17 nov. 2007 à 14:56
17 nov. 2007 à 14:56
Si tu expliquais un peu ce que tu cherches à faire ? J'y comprend rien à toutes ces boucles ...
Tu as plusieurs Do Until et tu utilises Select partout.
Si tu enlevais ces Select et plutôt appeler les cellules par "leurs noms" ou leur adresse, ça accélérerait pas mal les choses.
MPi²
Tu as plusieurs Do Until et tu utilises Select partout.
Si tu enlevais ces Select et plutôt appeler les cellules par "leurs noms" ou leur adresse, ça accélérerait pas mal les choses.
MPi²
cs_seeb
Messages postés
3
Date d'inscription
samedi 17 novembre 2007
Statut
Membre
Dernière intervention
17 novembre 2007
17 nov. 2007 à 17:06
17 nov. 2007 à 17:06
Bonjour,
alors pour répondre a la question, ces boucles servent a localiser les colone valeurs a utiliser, les données etant issus d'une requête dont je ne suis pas le développeur, je me suis affranchi du fait qu'elle pouvait etre modifié, mais ces boucle initiales sont faite une seule fois pour toute au lancement... par la suite c'est la boucle
Do While chligne <> 0
qui est utiliser afin de faire les calculs et c'est cette boucle qui est très longue, elle traite 6 ligne par seconde, sur 15 000 lignes ca fait bcp mais ce qui est paradoxal c'est que moins j'ai de ligne plus le nombre de ligne traité a la seconde est important
Serait ce la notion de "counter" qui ralentirai?
alors pour répondre a la question, ces boucles servent a localiser les colone valeurs a utiliser, les données etant issus d'une requête dont je ne suis pas le développeur, je me suis affranchi du fait qu'elle pouvait etre modifié, mais ces boucle initiales sont faite une seule fois pour toute au lancement... par la suite c'est la boucle
Do While chligne <> 0
qui est utiliser afin de faire les calculs et c'est cette boucle qui est très longue, elle traite 6 ligne par seconde, sur 15 000 lignes ca fait bcp mais ce qui est paradoxal c'est que moins j'ai de ligne plus le nombre de ligne traité a la seconde est important
Serait ce la notion de "counter" qui ralentirai?
cs_seeb
Messages postés
3
Date d'inscription
samedi 17 novembre 2007
Statut
Membre
Dernière intervention
17 novembre 2007
17 nov. 2007 à 21:45
17 nov. 2007 à 21:45
Bonsoir, je viens de modifier légérement les codes pour acceler, et je me suis appercu que c'est une seule ligne qui pénalise l'ensemble de l'exécution, pourriez vous m'aider a trouver une solution sur cette ligne unique? j'ai écri en rouge l'instruction qui ralenti, j'aurai du y penser, ce n'est pas tant le calcul qui pénalise, mais l'ecriture sur le fichier excel.
...
ActiveCell.Offset(0, chvide).Value = delais
...
merci pour votre aide ;)
Sub delai()
Range("A20").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim modelness As Boolean
Userform1.Show modelness
Dim chprod As Long
Dim chaff As Long
Dim chcOE As Long
Dim chrOE As Long
Dim chMGV As Long
Dim chdBloc As Long
Dim chfBloc As Long
Dim chvide As Long
Dim chligne As Long
Dim delta As Long
Dim prod As Date
Dim aff As Date
Dim cOE As Date
Dim rOE As Date
Dim datemax As Date
Dim tmp As String
Dim counterinit As Long
Dim counter As Long
Dim ch As Long
Dim MGV As Long
Dim dBloc As Date
Dim fBloc As Date
Dim delais As Long
chprod = 0
chaff = 0
chcOE = 0
chrOE = 0
chMGV = 0
chdBloc = 0
chfBloc = 0
chvide = 0
chligne = 0
delta = 0
counterinit = 0
Do Until ActiveCell = "Destination"
ActiveCell.Offset(1, 0).Select
counterinit = counterinit + 1
If counterinit > 100 Then
GoTo fin_procedure
End If
Loop
counter = 0
Do Until ActiveCell = "Date de production"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chprod = counter
Do Until ActiveCell = "Date d'affectation"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chaff = counter
Do Until ActiveCell = "Date création OE"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chcOE = counter
Do Until ActiveCell = "Date répartition OE"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chrOE = counter
Do Until ActiveCell = "Date d'entrée MGV"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chMGV = counter
Do Until ActiveCell = "Date début blocage"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chdBloc = counter
Do Until ActiveCell = "Date fin blocage"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chfBloc = counter
Do While ActiveCell <> Empty
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chvide = counter
ActiveCell.Offset(1, -counter).Select
counter = 0
Do While ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
counter = counter + 1
Loop
chligne = counter
ch = counter
ActiveCell.Offset(-counter, 0).Select
'********************************************************
'*MàJ des délais Ligne à Ligne par boucles *
'********************************************************
Do While chligne <> 0
prod = DateValue(ActiveCell.Offset(0, chprod).Value)
aff = DateValue(ActiveCell.Offset(0, chaff).Value)
cOE = DateValue(ActiveCell.Offset(0, chcOE).Value)
rOE = DateValue(ActiveCell.Offset(0, chrOE).Value)
If ActiveCell.Offset(0, chMGV).Value <> "#" Then
MGV = DateValue(ActiveCell.Offset(0, chMGV).Value)
Else: MGV = 0
End If
If ActiveCell.Offset(0, chdBloc).Value <> "#" Then
dBloc = DateValue(ActiveCell.Offset(0, chdBloc).Value)
Else: dBloc = 0
End If
If ActiveCell.Offset(0, chfBloc).Value <> "#" Then
fBloc = DateValue(ActiveCell.Offset(0, chfBloc).Value)
Else: fBloc = 0
End If
tmp = ""
'If dBloc <> 0 Then
'If fBloc = 0 Then
'tmp = "bloc"
'End If
'End If
datemax = WorksheetFunction.Max(prod, aff, cOE, rOE, MGV, fBloc, dBloc)
delais = WorksheetFunction.Days360(datemax, Date)
'If tmp <> "bloc" Then
ActiveCell.Offset(0, chvide).Value = delais
'Else: ActiveCell.Offset(0, chvide).Value = 0
'End If
ActiveCell.Offset(1, 0).Select
chligne = chligne - 1
delta = ch - chligne
'Avancement du calcul ligne
x = delta * 100 \ ch
Call MaJBarre(x, delta)
Loop
fin_procedure:
Unload Userform1
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub MaJBarre(pourcent, ligne)
pourcent = pourcent / 100
With Userform1
.CadreDeLaBarre.Caption = Format(pourcent, "0%")
.IntituléBarre.Width = pourcent * (.CadreDeLaBarre.Width - 10)
If pourcent = 100 Then
.Suivi.Caption = "Fin des MàJ "
Else
.Suivi.Caption = "Calcul ligne " & ligne
End If
End With
'Commande Mettant a Jour la Barre
DoEvents
End Sub
...
ActiveCell.Offset(0, chvide).Value = delais
...
merci pour votre aide ;)
Sub delai()
Range("A20").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim modelness As Boolean
Userform1.Show modelness
Dim chprod As Long
Dim chaff As Long
Dim chcOE As Long
Dim chrOE As Long
Dim chMGV As Long
Dim chdBloc As Long
Dim chfBloc As Long
Dim chvide As Long
Dim chligne As Long
Dim delta As Long
Dim prod As Date
Dim aff As Date
Dim cOE As Date
Dim rOE As Date
Dim datemax As Date
Dim tmp As String
Dim counterinit As Long
Dim counter As Long
Dim ch As Long
Dim MGV As Long
Dim dBloc As Date
Dim fBloc As Date
Dim delais As Long
chprod = 0
chaff = 0
chcOE = 0
chrOE = 0
chMGV = 0
chdBloc = 0
chfBloc = 0
chvide = 0
chligne = 0
delta = 0
counterinit = 0
Do Until ActiveCell = "Destination"
ActiveCell.Offset(1, 0).Select
counterinit = counterinit + 1
If counterinit > 100 Then
GoTo fin_procedure
End If
Loop
counter = 0
Do Until ActiveCell = "Date de production"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chprod = counter
Do Until ActiveCell = "Date d'affectation"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chaff = counter
Do Until ActiveCell = "Date création OE"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chcOE = counter
Do Until ActiveCell = "Date répartition OE"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chrOE = counter
Do Until ActiveCell = "Date d'entrée MGV"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chMGV = counter
Do Until ActiveCell = "Date début blocage"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chdBloc = counter
Do Until ActiveCell = "Date fin blocage"
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chfBloc = counter
Do While ActiveCell <> Empty
ActiveCell.Offset(0, 1).Select
counter = counter + 1
Loop
chvide = counter
ActiveCell.Offset(1, -counter).Select
counter = 0
Do While ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
counter = counter + 1
Loop
chligne = counter
ch = counter
ActiveCell.Offset(-counter, 0).Select
'********************************************************
'*MàJ des délais Ligne à Ligne par boucles *
'********************************************************
Do While chligne <> 0
prod = DateValue(ActiveCell.Offset(0, chprod).Value)
aff = DateValue(ActiveCell.Offset(0, chaff).Value)
cOE = DateValue(ActiveCell.Offset(0, chcOE).Value)
rOE = DateValue(ActiveCell.Offset(0, chrOE).Value)
If ActiveCell.Offset(0, chMGV).Value <> "#" Then
MGV = DateValue(ActiveCell.Offset(0, chMGV).Value)
Else: MGV = 0
End If
If ActiveCell.Offset(0, chdBloc).Value <> "#" Then
dBloc = DateValue(ActiveCell.Offset(0, chdBloc).Value)
Else: dBloc = 0
End If
If ActiveCell.Offset(0, chfBloc).Value <> "#" Then
fBloc = DateValue(ActiveCell.Offset(0, chfBloc).Value)
Else: fBloc = 0
End If
tmp = ""
'If dBloc <> 0 Then
'If fBloc = 0 Then
'tmp = "bloc"
'End If
'End If
datemax = WorksheetFunction.Max(prod, aff, cOE, rOE, MGV, fBloc, dBloc)
delais = WorksheetFunction.Days360(datemax, Date)
'If tmp <> "bloc" Then
ActiveCell.Offset(0, chvide).Value = delais
'Else: ActiveCell.Offset(0, chvide).Value = 0
'End If
ActiveCell.Offset(1, 0).Select
chligne = chligne - 1
delta = ch - chligne
'Avancement du calcul ligne
x = delta * 100 \ ch
Call MaJBarre(x, delta)
Loop
fin_procedure:
Unload Userform1
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub MaJBarre(pourcent, ligne)
pourcent = pourcent / 100
With Userform1
.CadreDeLaBarre.Caption = Format(pourcent, "0%")
.IntituléBarre.Width = pourcent * (.CadreDeLaBarre.Width - 10)
If pourcent = 100 Then
.Suivi.Caption = "Fin des MàJ "
Else
.Suivi.Caption = "Calcul ligne " & ligne
End If
End With
'Commande Mettant a Jour la Barre
DoEvents
End Sub
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
18 nov. 2007 à 15:33
18 nov. 2007 à 15:33
Personnellement, je recommencerais le tout à 0...avec une autre approche. Ces Do While ou Do Until avec Select m'agacent....
Lorsque tu écris
ActiveCell.Offset(0, chvide).Value = delais
Est-ce qu'il se peut que plusieurs formules du fichier se recalculent à chaque changement de cette "Activecell" ?
Si oui, tu pourrais peut-être mettre le mode Calculation = Manual avant la boucle et le remettre à Automatic à la fin...(?)
MPi²
Lorsque tu écris
ActiveCell.Offset(0, chvide).Value = delais
Est-ce qu'il se peut que plusieurs formules du fichier se recalculent à chaque changement de cette "Activecell" ?
Si oui, tu pourrais peut-être mettre le mode Calculation = Manual avant la boucle et le remettre à Automatic à la fin...(?)
MPi²
