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
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
Solutions-xl
Le #20593931
On 20 nov, 11:33, 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, SearchDirectio n:=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 = Var Cell03
    VarCell03 = Empty
CompT01 = CompT01 + 1
Loop Until CompT01 > 1500

Application.ScreenUpdating = True



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
LSteph
Le #20593921
Bonjour,

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
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, SearchDirectio n:=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 = Var Cell03
    VarCell03 = Empty
CompT01 = CompT01 + 1
Loop Until CompT01 > 1500

Application.ScreenUpdating = True


SLED
Le #20594901
Merci de votre aide.

Pour un fichier type
http://www.cijoint.fr/cjlink.php?file=cj200911/cijuFiEjGe.xlsm

c'est surtout le find qui prend du tps.
Pour le .select, c'est une entouloupe à mes manquements

A+
SLED
SLED
Le #20595001
Bjr,

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 :

Bonjour,

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 > 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

.



LSteph
Le #20596031
re,
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
Bjr,

Entièrement d'accord avec la simple formule.
Oui, mais la répétition de la formule sur un min de 1500 record bloqu e la
feuille.

A+
SLed

"LSteph" a écrit :



> Bonjour,

> 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 > > Bonjour,

> > Merci de votre aide.

> > Pourriez-vous m'indiquer un moyen pour améliorer la rapidité du c ode 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, SearchDire ction:=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

> .- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -


SLED
Le #20679321
Merci pour votre aide.

J'ai supprimé les .select

Pour la solution précédente, elle fonctionne mais lorsque l'on la copie 1500
fois, le tps de fonctionnement est trop important.

Je vais essayer de limiter la recherche sur une plage plus limitée.

A+
SLED
Publicité
Poster une réponse
Anonyme