Raccourcir temps d'execution loop

[Franzz]

Raccourcir temps d'execution loop [RESOLU]

Bonjour,

j'ai un petit code VBA qui me permet de mettre une valeur dans plusieurs cellules d'une colonne en fonction des valeurs des cellules d'une autre colonne au moment d'un clic :

le code vérife la position du clic puis va chercher dans l'autre colonne (colonne1) la valeur. il remonte jusqu'a ne plus trouver cette valeur, puis redesend en inserant la valeur désirer dans chacune des cellules de l'autre colonne.

Public Sub ajoutvaleur(ByVal Target As Range)
Dim valeur As Double
If Not Intersect(Target, Range("H3:H500")) Is Nothing Then
valeur = 1
Selection.Offset(0, -3).Range("A1").Select
Dim colonne1 As Integer
colonne1 = Selection.Value
Do While Selection.Value = colonne1
Selection.Offset(-1, 0).Range("A1").Select
Loop
Selection.Offset(1, 0).Range("A1").Select
Do While Selection.Value = colonne1
Selection.Offset(0, 3).Value = valeur
Selection.Offset(1, 0).Range("A1").Select
Loop
End If
End Sub

Le problème etant que c'est une opération longue et je suis sur qu'il y a un moyen plus simple de le faire, non ? 😉

 

[Cousinhub]

Re : Raccourcir temps d'execution loop

Bonjour,

pourrais-tu mettre un fichier exemple?

A te relire

 

[Franzz]

Re : Raccourcir temps d'execution loop

oui voila,

j'ai changé la valeur modifié par "now()" pour que ca soit bien visible

 

[Cousinhub]

Re : Raccourcir temps d'execution loop

Re-,

un essai :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Valeur As Double, X, PremCel As Integer, Hauteur As Integer
If Target.Count = 1 Then
If Not Intersect(Target, Range("H2:H" & [H65000].End(xlUp).Row)) Is Nothing Then
    Valeur = Now()
    X = Target.Offset(0, -3).Value
    PremCel = Application.Match(X, Columns(5), 0)
    Hauteur = Application.CountIf(Columns(5), X)
    Cells(PremCel, 8).Resize(Hauteur, 1).Value = Valeur
End If
End If
End Sub

 

[Franzz]

Re : Raccourcir temps d'execution loop

Merci beaucoup 🙂