VBA pour gestion de boucle

Version imprimable

11/09/2012, 13h35
yeahna

1 pièce(s) jointe(s)

VBA pour gestion de boucle

Bonjour,

J'ai une grande faveur à demander, j'aimerais pouvoir faire une recherche itérative dans un de mes fichiers.

Dans le fichier, ci-joint, j'ai besoin de rechercher dans la colonne B, la première valeur plus grande ou égale à la cellule G11. (Dans cet exemple, c'est la cellule B5.)
Ensuite j'aurais besoin de copier la valeur de B5 dans la cellule G12 et de copier l'identifiant qui correspond à B5, càd la valeur de la cellule A5 dans la cellule G13.

Je comprends le code en VBA mais je ne sais pas le créer.
Quelqu'un pourrait-il m'aider à résoudre ce problème svp?

Mille mercis d'avance!

Jenna

bonjour

Essaie ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub test()
Dim Valeur As Integer
 
 
With Sheet1
    Valeur = .Range("g11").Value
    For cpt = 1 To .Range("b65536").End(xlUp).Row
        If .Cells(cpt, 2) >= Valeur Then
            .Range("g12") = .Cells(cpt, 2).Value
            .Range("g13") = .Cells(cpt, 1).Value
 
        End If
 
    Next cpt
 
 
End With
End Sub

11/09/2012, 15h51
yeahna

Il n'y a rien qui se passe.
Je dois bien mettre le code sur la Sheet1?
11/09/2012, 16h13
evx136

1 pièce(s) jointe(s)

Aller

tu as le fichier en PJ

Cordialement

Bonjour
à evx136

Ajoute un Exit For pour sortir de la boucle

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Test()
Dim Valeur As Double
Dim Cpt As Long
 
With Sheet1
    Valeur = .Range("G11").Value
    For Cpt = 1 To .Range("B65536").End(xlUp).Row
        If .Cells(Cpt, 2) >= Valeur Then
            .Range("G12") = .Cells(Cpt, 2).Value
            .Range("G13") = .Cells(Cpt, 1).Value
            Exit For
        End If
    Next Cpt
End With
End Sub

12/09/2012, 08h45
yeahna

Super merci à vous deux maintenant ça marche parfaitement!:ccool:

Encore juste une petite chose (en espérant ne pas abuser de votre gentillesse).

Y a-t-il moyen de générer ce code directement lors du changement de valeur de la celulle, sans avoir un bouton de commande?

Mille mille mercis :D

Je pense avoir trouvé une piste mais tout de même une question:
Lorsque j'utilise le code suivant pour éviter le bouton de commande, je dois qand même cliquer sur la celulle qui s'est modifié "G20" pour que G 21 et G 22 se mette à jour, n'y a-t-il pas moyen que dès que la cellule G20 change, G21 et G22 changent aussi sans clic?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Valeur As Double Dim Cpt As Long With Sheet9 Valeur = .Range("G20").Value For Cpt = 8 To .Range("D65536").End(xlUp).Row If .Cells(Cpt, 4) >= Valeur Then .Range("G21") = .Cells(Cpt, 4).Value .Range("G22") = .Cells(Cpt, 3).Value Exit For End If Next Cpt End With End Sub
Merci :)

12/09/2012, 10h58
evx136

Bonjour
Chez moi ça marche.
Il faut placer ton code non pas dans un module mais dans la feuille correspondante de ton projet VBA.
J'ai aussi remarqué que tu avais modifier les colonnes des valeurs à trouver.

es tu sur de ça

Cordialement
12/09/2012, 11h16
HopPopPop

Bonjour à tous.

Dans le cas où la valeur de la cellule G20 se rafraichit par une formule présente dans celle-ci et non par une valeur entrée manuellement.
Mettre le contenu du code dans la procédure Private Sub Worksheet_Calculate() de la feuille concernée.
cordialement.

Pour le code, j'avais en effet changé en utilisant la feuille correspondante au projet VBA.
En ce qui concerne les colonnes des valeurs à trouver, j'ai mis le code du fichier dans lequel je travaille, j'ai adapté les variables.

Je pense, comme dit, HopPopPop qu'il y a peut-être un soucis du au fait que dans le fichier que j'utilise, il y a une formule dans la celulle et non pas une valeur entrée manuellement.

(J'avais voulu simplifier le fichier que je joignais ici)

Bien à toi,

Jenna

En effet, il s'agit bien d'une formule présente dans G20. Cependant quand j'utilise le code suivant, il m'indique une erreur à la ligne 7: "out of stack space"

Savez-vous comment corriger cela?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Worksheet_Calculate() Dim Valeur As Double Dim Cpt As Long With Sheet9 Valeur = .Range("G20").Value For Cpt = 8 To .Range("D65536").End(xlUp).Row If .Cells(Cpt, 4) >= Valeur Then .Range("G21") = .Cells(Cpt, 4).Value .Range("G22") = .Cells(Cpt, 3).Value Exit For End If Next Cpt End With End Sub

12/09/2012, 15h03
HopPopPop

J'ai fait l'essai avec le code tel quel, en adaptant le fichier.
Je n'ai pas de message d'erreur, il se déroule correctement.

Pour confirmation, Sheet9 est bien le codeName de la feuille ?
C'est une version anglaise ?
12/09/2012, 17h58
yeahna

Oui c'est bien le codename de la feuille.
Et, oui c'est une version anglaise.

L'erreur peut-elle être due à la taille de mon fichier excel?

J'ai fait un essai avec un fichier volumineux et beaucoup de cellules comportant des formules.
Là, j'ai constaté qu'il tournait en boucle.
En mode pas-à-pas, le fait d'écrire les valeurs dans G21 & G22 relancent la procédure.

En ajoutant l'instruction Application.EnableEvents à False puis à True évite cela.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Private Sub Worksheet_Calculate() Dim Valeur As Double Dim Cpt As Long With Sheet9 Valeur = .Range("G20").Value For Cpt = 8 To .Range("D65536").End(xlUp).Row If .Cells(Cpt, 4) >= Valeur Then Application.EnableEvents = False .Range("G21") = .Cells(Cpt, 4).Value .Range("G22") = .Cells(Cpt, 3).Value Application.EnableEvents = True Exit For End If Next Cpt End With End Sub

13/09/2012, 09h00
yeahna

Super, ça fonctionne!
Mille mercis :ccool: