Creation boucle vba excel

Version imprimable

Bonjour, j'ai créer ce code mais j'aimerais que au lieu d'a chaque fois changé B2,B3,B4 etc que le code fasse la recherche dans la colonne entière et puis sélectionné le type de conducteur !
Pouvez vous m'aidez ? 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
Sub Evaluation()
 
  'Statut du conducteur
   If Range("B2").Value >= 9 And Range("B1").Value < 10 Then
      Range("J2").Value = " très bon conducteur par les passagers"
 
 ElseIf Range("B2").Value >= 7 And Range("B1").Value < 9 Then
          Range("J2").Value = "bon conducteurs"
 
   ElseIf Range("B2").Value >= 5 And Range("B1").Value < 7 Then
          Range("J3").Value = "comme conducteur moyen par les passagers"
 
   ElseIf Range("B2").Value < 5 And Range("B1").Value >= 3 Then
          Range("J2").Value = " comme mauvais conducteur par les passagers"
 
   ElseIf Range("B2").Value = 10 Then
          Range("J2 ").Value = " le top du top !"
 
    Else
           Range("J2").Value = " comme très mauvais conducteur par les passagers"
 
   End If
   MsgBox "Ce conducteur a été jugé"
 
End Sub

Salut gaever,

Pas testé le code ci-dessous, mais, pour ce que tu demandes, j'espère qu'il n'y aura pas d'erreur ! :aie:

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
Sub Evaluation_gaever()
 
With Worksheets("Ma feuille d'évaluation")
    Set rng = .Range("B1")
 
    For i = 1 To .Columns(2).Find("*", , , , , xlPrevious).Row - 1
        'Statut du conducteur
        If rng.Offset(i, 0) >= 9 And rng.Offset(i - 1, 0).Value < 10 Then
            rng.Offset(i, 8) = " très bon conducteur par les passagers"
 
        ElseIf rng.Offset(i, 0).Value >= 7 And rng.Offset(i - 1, 0).Value < 9 Then
            rng.Offset(i, 8).Value = "bon conducteurs"
 
        ElseIf rng.Offset(i, 0).Value >= 5 And rng.Offset(i - 1, 0).Value < 7 Then
            rng.Offset(i, 8).Value = "comme conducteur moyen par les passagers"
 
        ElseIf rng.Offset(i, 0).Value < 5 And rng.Offset(i - 1, 0).Value >= 3 Then
            rng.Offset(i, 8).Value = " comme mauvais conducteur par les passagers"
 
        ElseIf rng.Offset(i, 0) = 10 Then
            rng.Offset(i, 8).Value = " le top du top !"
 
        Else
            rng.Offset(i, 8).Value = " comme très mauvais conducteur par les passagers"
 
        End If
    Next i
End With
 
End Sub

Si ça ne compile pas ou que j'ai mal compris ta demande, n'hésite pas à revenir vers moi. :ccool:

Cordialement,
Kimy

1 pièce(s) jointe(s)

Bonjour !
Merci d'avoir répondu mais malheureusement le code ne fonctionne pas :(
Pièce jointe 163631
Voici ma feuille excel, j'aimerais créer un code VBA pour que en fonction de la note d'évaluation il y ai un commentaire dans une autre case ! j'ai déjà écrit ce code la mais il ne le fait que pour la case sélectionné dans range("B2") et j'aimerais que au lieu de a chaque fois changer cette case que il y ai une boucle pour que il le fasse lui même ! j'espère que j'ai pas trop été confu dans mon explication.
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 Sub Evaluation() 'Statut du conducteur If Range("B2").Value >= 9 And Range("B1").Value < 10 Then Range("J2").Value = " très bon conducteur par les passagers" ElseIf Range("B2").Value >= 7 And Range("B1").Value < 9 Then Range("J2").Value = "bon conducteurs" ElseIf Range("B2").Value >= 5 And Range("B1").Value < 7 Then Range("J3").Value = "comme conducteur moyen par les passagers" ElseIf Range("B2").Value < 5 And Range("B1").Value >= 3 Then Range("J2").Value = " comme mauvais conducteur par les passagers" ElseIf Range("B2").Value = 10 Then Range("J2 ").Value = " le top du top !" Else Range("J2").Value = " comme très mauvais conducteur par les passagers" End If MsgBox "Ce conducteur a été jugé" End Sub

Et ça ?

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
Sub Evaluation_gaever()
 
With Worksheets("Ma feuille d'évaluation")
    Set rng = .Range("B1")
 
    For i = 1 To .Columns(2).Find("*", , , , , xlPrevious).Row - 1
        'Statut du conducteur
        If rng.Offset(i, 0) >= 9 And rng.Offset(i, 0).Value < 10 Then
            rng.Offset(i, 8) = " très bon conducteur par les passagers"
 
        ElseIf rng.Offset(i, 0).Value >= 7 And rng.Offset(i, 0).Value < 9 Then
            rng.Offset(i, 8).Value = "bon conducteurs"
 
        ElseIf rng.Offset(i, 0).Value >= 5 And rng.Offset(i, 0).Value < 7 Then
            rng.Offset(i, 8).Value = "comme conducteur moyen par les passagers"
 
        ElseIf rng.Offset(i, 0).Value < 5 And rng.Offset(i, 0).Value >= 3 Then
            rng.Offset(i, 8).Value = " comme mauvais conducteur par les passagers"
 
        ElseIf rng.Offset(i, 0) = 10 Then
            rng.Offset(i, 8).Value = " le top du top !"
 
        Else
            rng.Offset(i, 8).Value = " comme très mauvais conducteur par les passagers"
 
        End If
    Next i
End With
 
End Sub

15/12/2014, 10h59
gaever

1 pièce(s) jointe(s)

J'ai ce message qui apparait ...

Pièce jointe 163880

Bonjour,
Essayes ce code, mais avant il faut renommer ta feuille EVALUATION ou remplacer EVALUATION dans

Code:

Set eval = ThisWorkbook.Sheets("EVALUATION")

par le nom de ta feuille

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
Option Explicit
 
Sub Evaluation()
Dim eval As Worksheet
Dim i As Integer
Set eval = ThisWorkbook.Sheets("EVALUATION")
i = 2
 
   Do While eval.Cells(i, 2) <> ""
   eval.Cells(i, 2).Select
 
                    If eval.Cells(i, 2) >= 9 And eval.Cells(i, 2) < 10 Then
                    eval.Cells(i, 10) = "très bon ...."
                    ElseIf eval.Cells(i, 2) = 10 Then
                    eval.Cells(i, 10) = "Top du Top"
                    ElseIf eval.Cells(i, 2) >= 7 And eval.Cells(i, 2) < 9 Then
                    eval.Cells(i, 10) = "Bon "
                    ElseIf eval.Cells(i, 2) >= 5 And eval.Cells(i, 2) < 7 Then
                    eval.Cells(i, 10) = "Moyen"
                    Else
                    eval.Cells(i, 10) = "Mauvais"
                    End If
                    i = i + 1
             MsgBox "Ce conducteur a été jugé"
 
 
 
     Loop
 
End Sub

Eric

15/12/2014, 15h31
gaever

UN GRAND MERCI ERIC ! il fonctionne à merveille, je vous souhaite une bonne fin de journée :)

Voici une variante avec Select Case (Merci MarcelG)

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
Sub Evaluation_SelectCase()
 
Dim data As Worksheet
Dim dern_row As Integer
Dim i As Integer
Dim Cond As Integer
Dim commentaire As String
 
 
Set data = ThisWorkbook.Sheets(1)
 
With data
    dern_row = .Cells(.Rows.Count, 2).End(xlUp).Row
 
    For i = 1 To dern_row
 
        With .Cells(i, 2)
data.Cells(i, 2).Select
            Select Case .Value
 
                Case 10
                    commentaire = "Top du Top"
 
                Case 9
                    commentaire = "très bon"
 
                Case 7, 8
                    commentaire = " bon"
 
                Case 5, 6, 7
                    commentaire = "moyen"
 
                Case Else
                    commentaire = "Mauvais"
            End Select
 
           .Offset(0, 9).Value = commentaire
        End With
 
    Next i
 
End With
 
Set data = Nothing
End Sub

Eric

15/12/2014, 15h41
eric4459

Gaever

Dans le premier code proposé il y a ceci

Code:

eval.Cells(i, 2).Select

Tu peux l'enlever car non recommandé par les puristes :scarymov:, cela "bouffe" de la mémoire INUTILEMENT.
J'aime m'en servir quand je créé du code afin de pouvoir visualiser en pas à pas ce qui se passe, mais ensuite il faut l'enlever, ça ne gênera pas le fonctionnement.

Eric