Condition pour boucle

Version imprimable

Bonjour a tous,

Dans le fichier joint, je rencontre un problème avec la condition de ma boucle. Il me répète les résultats plusieurs fois. Quelqu'un pourrait-il m'aider? je peux lui donner mon fichier.
Merci d'avance

Voici mon code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 18/04/2008 par AXC8300
'
'
Dim j As Double, k As Double
    Sheets("Feuil2").Select
    Range("A9").Select
    ligne = Range("A9").Value
    Cells(9, 2).Select
    A = Cells(9, 2).Value
    Cells(9, 3).Select
    B = Cells(9, 3).Value
    Range("A6").Select
    zone = Range("A6").Value
    Cells(6, 2).Select
    feuille = Cells(6, 2).Value
    Range("A13:T999").Select
    Selection.ClearContents
    Range("j6:T6").Select
    Selection.ClearContents
    Sheets("resume").Select
    Cells(1, 1).Select
    k = 13
    l = 2
    i = 1
    If zone <> "" Then
    While l > i
    Cells.Find(What:=zone, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    l = ActiveCell.Row
    Cells(l, 5).Select
    If feuille = Cells(l, 5).Value Then
    Rows(l).Select
    Selection.Copy
    Sheets("Feuil2").Select
    Cells(k, 1).Select
    ActiveSheet.Paste
    k = k + 1
    Sheets("resume").Select
    i = i + 1
    Cells(l + 1, 1).Select
    If l < i Then
    Sheets("Feuil2").Select
    Rows(k - 1).Select
    Rows(k - 1).Clear
    End If
    Else
    i = i + 1
    End If
   Wend
   Else
   While l > i
     Cells.Find(What:=ligne, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    l = ActiveCell.Row
    Cells(l, 2).Select
    If A = Cells(l, 2).Value Then
    If B = Cells(l, 3).Value Then
    Rows(l).Select
    Selection.Copy
    Sheets("Feuil2").Select
    Cells(k, 1).Select
    ActiveSheet.Paste
    k = k + 1
    Sheets("resume").Select
    i = i + 1
    Cells(l, 1).Select
     End If
    Else
    i = i + 1
    Cells(l, 1).Select
    End If
   Wend
   End If
   Sheets("Feuil2").Select
   For i = 0 To 10
   Cells(6, 10 + i).Select
   ActiveCell.FormulaR1C1 = "=MAX(R[7]C:R[9999]C)"
   Next
   End Sub

23/05/2008, 16h43
Gorfael

Salut fisico016 et le forum
Plusieurs remarques d'ordre général :
- Au lieu de faire un nouveau poste, quand c'est la même contenu, édite-le.

Dans ton code :
- déclare toutes tes variables, c'est mieux
- l'indentation du code nest pas là pour faire beau : c'est pour te permettre de visualiser les limites des bucles, tests, etc...

Pour ta question, n'ayant que le code je ne peux vérifier
Cells.Find(What:=zone...
avec cette méthode, quand tu arrives à la fin de la plage à vérifier, tu recommences au début => va voir l'exemple de l'aide : il fixe la 1re cellule trouvée dans une variable, et quand il retombe dessus, il arrête (ce que tu ne fais pas)

Avec une idée de ce qu'on doit faire, on pourrait épurer ton code : ne plus travailler sur la cellule active, ne plus faire de select ni changer de feuille. Mais pour ça, il faudrait un fichier d'essai (1 feuille contenant de quoi faire tourner la boucle 3 ou 4 fois, la seconde, on peut la créer)

A+
24/05/2008, 15h07
Montor
Vous utiliser beaucoup des "Select ,Activate " qui augmente enormement de temps execution et vous avez utiliserd'une mauvaise maniere la fontion "Find"
EX
Code:

1 2 3 4 Sheets("Feuil2").Select Range("A9").Select igne = Range("A9").Value
simplement
Code:

1 2 ligne = Sheets("Feuil2").Range("A9")

Citation:

Envoyé par Gorfael

- Au lieu de faire un nouveau poste, quand c'est la même contenu, édite-le.

J'ajoute juste "et indente correctement ton code, là il est illisible si on ne le fait pas à ta place à moins... de le relire plusieurs fois ;)

Je viens de regarder ton code et j'ai essayé de voir s'il était possible de t'aider mais il contient vraiment trop d'erreurs et je me suis arrêté en route.
Si quelqu'un veut prendre la suite, les deux boucles While contiennent une recherche avec Find qui, même partiellement corrigée (manque le test [if not c is nothing]), ramènera toujours sur la même donnée, ainsi que l'indiquait Delphidelphi. Mais pour continuer, il lui faudra les deux versions... C'est pourquoi je te mets le code, toi seul pouvant comprendre ce que tu veux faire.
Quant au reste, je me suis contenté de supprimer les selections que je comprenais :(

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub Macro2()
Dim j As Double, k As Double
Dim c as range
    With Sheets("Feuil2")
    ligne = .Range("A9").Value
    A = .Cells(9, 2).Value
    B = .Cells(9, 3).Value
    zone = .Range("A6").Value
    feuille = .Cells(6, 2).Value
    .Range("A13:T999").ClearContents
    .Range("j6:T6").ClearContents
    k = 13
    l = 2
    i = 1
    If zone <> "" Then
        With Sheets("resume")
            While l > i
                set c = .Cells.Find(What:=zone, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                , SearchFormat:=False)
                l = c.Row
                If feuille = .Cells(l, 5).Value Then
                     .Rows(l).Entirerow.Copy Sheets("Feuil2").Cells(k, 1).Paste
                     k = k + 1
                     i = i + 1
                     '.Cells(l + 1, 1).Select 'sert à quoi ?
                     If l < i Then _
                          Sheets("Feuil2").Rows(k - 1).Clearcontents
                Else
                     i = i + 1
                End If
           Wend
           Else
           While l > i
               Cells.Find(What:=ligne, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
               xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
               False, SearchFormat:=False).Activate
               l = ActiveCell.Row
               If A = Cells(l, 2).Value Then
                    If B = Cells(l, 3).Value Then
                         Rows(l).Copy Sheets("Feuil2").Cells(k, 1).Paste
                         k = k + 1
                         i = i + 1
                         Sheets("resume").Select
                         Cells(l, 1).Select
                    End If
                  Else
                     i = i + 1
                    Cells(l, 1).Select
               End If
           Wend
    End If
    Sheets("Feuil2").Select
    For i = 0 To 10
        Cells(6, 10 + i).FormulaR1C1 = "=MAX(R[7]C:R[9999]C)"
   Next
End Sub

Pour la recherche avec Find, regarde dans l'aide, tu as un excellent exemple qui convient à ce que tu "sembles" vouloir faire.
Bon courage, tu n'es pas sorti de l'ornière. Désolé.

26/05/2008, 09h48
fisico016

re:

Merci à tous pour vos commentaires.