améliorer la rapidité d'un code
Le
SLED
Bonjour,
Merci de votre aide.
Pourriez-vous m'indiquer un moyen pour améliorer la rapidité du code repris
si dessous ?
Le but du code est de trouver à partir d'une liste, une valeur dans un
tableau et de renvoyer une date y afférent.
Les données sont assez importante en volume.
La fonction cells.find() prend bcp de temps.
A+
SLED
Aller à la première page
Sheets("WBB").Select
Range("date_replanning").Select
'Prendre les coordonnées de date_replanning
RowPosition_01 = ActiveCell.Row
CoLonnePosition_01 = ActiveCell.Column
'Prendre les coordonnées de WBB_num
Range("WBB_num").Select
RowPosition_02 = ActiveCell.Row
CoLonnePosition_02 = ActiveCell.Column
Do
'Prendre la valeur dans WBB_num
Cells(RowPosition_02 + CompT01, CoLonnePosition_02).Select
VarCell02 = Cells(RowPosition_02 + CompT01, CoLonnePosition_02).Value
If VarCell02 = "" Then Exit Sub
Sheets("werfplanning").Select
Set RepOnsE = Cells.Find(VarCell02, After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse)
If Not RepOnsE Is Nothing Then
RepOnsE.Select
RowPosition_03 = ActiveCell.Row
CoLonnePosition_03 = ActiveCell.Column
VarCell03 = Cells(7, CoLonnePosition_03).Value
Else
VarCell03 = "Inplannen"
End If
Sheets("WBB").Select
Cells(RowPosition_01 + CompT01, CoLonnePosition_01).Value = VarCell03
VarCell03 = Empty
CompT01 = CompT01 + 1
Loop Until CompT01 > 1500
Application.ScreenUpdating = True
Merci de votre aide.
Pourriez-vous m'indiquer un moyen pour améliorer la rapidité du code repris
si dessous ?
Le but du code est de trouver à partir d'une liste, une valeur dans un
tableau et de renvoyer une date y afférent.
Les données sont assez importante en volume.
La fonction cells.find() prend bcp de temps.
A+
SLED
Aller à la première page
Sheets("WBB").Select
Range("date_replanning").Select
'Prendre les coordonnées de date_replanning
RowPosition_01 = ActiveCell.Row
CoLonnePosition_01 = ActiveCell.Column
'Prendre les coordonnées de WBB_num
Range("WBB_num").Select
RowPosition_02 = ActiveCell.Row
CoLonnePosition_02 = ActiveCell.Column
Do
'Prendre la valeur dans WBB_num
Cells(RowPosition_02 + CompT01, CoLonnePosition_02).Select
VarCell02 = Cells(RowPosition_02 + CompT01, CoLonnePosition_02).Value
If VarCell02 = "" Then Exit Sub
Sheets("werfplanning").Select
Set RepOnsE = Cells.Find(VarCell02, After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse)
If Not RepOnsE Is Nothing Then
RepOnsE.Select
RowPosition_03 = ActiveCell.Row
CoLonnePosition_03 = ActiveCell.Column
VarCell03 = Cells(7, CoLonnePosition_03).Value
Else
VarCell03 = "Inplannen"
End If
Sheets("WBB").Select
Cells(RowPosition_01 + CompT01, CoLonnePosition_01).Value = VarCell03
VarCell03 = Empty
CompT01 = CompT01 + 1
Loop Until CompT01 > 1500
Application.ScreenUpdating = True
Poser une question
Bonjour
Eviter les "select"
Ce serait bien d'avoir la totalité du code...
On peut éventuellement remplacer le Find mais il faudrait donner les
règles de recherche ...
A +
Peut etre un peit fichier joint
Philippe
www.solutions-xl.com
Une simple formule du genre =index(montab;equiv(maval;matrice;
0);macolonne)
pertmettrait vvisiblement de remplacer tout cela.
Sinon
Pour le code simplifie, vire tous ces selects (comme on a cesse de le
dire) toujours aussi indéfectiblement inutiles exemple:
RP_01=[date_replanning].row
de même pour décaler tu as
.offset(lig,col)
Pour plus mets un exemple de ton classeur en cjoint.com et redonne le
lien ici
On va démêler tout cela!
--
lSteph
On 20 nov, 11:33, SLED
Pour un fichier type
http://www.cijoint.fr/cjlink.php?fi...iEjGe.xlsm
c'est surtout le find qui prend du tps.
Pour le .select, c'est une entouloupe à mes manquements
A+
SLED
Entièrement d'accord avec la simple formule.
Oui, mais la répétition de la formule sur un min de 1500 record bloque la
feuille.
A+
SLed
"LSteph" a écrit :
dans ce cas en nommant dans Werfplanning la plage planning, ceci
serait-il plus rapide
(attention fonction à mettre dans un module standard et non dans le
thisworkbook comme tu avais fait)
A utiliser ainsi ensuite en D2 de la feuille WBB tu mets =rdate(C2)
à recopier vers bas
Function rdate(ByVal myr As String) As String
Dim c As Range, plage As Range
Set plage = Worksheets("werfplanning").[planning]
Application.Volatile
For Each c In plage.Cells
If c.Value = myr Then
rdate = Worksheets("werfplanning").Cells(7, c.Column): Exit For
End If
Next
Set plage = Nothing
End Function
'lSteph
On 20 nov, 15:07, SLED