"Corrigé" de macros

Version imprimable

"Corrigé" de macros

Bonjour,

Dans le cadre d'une évaluation,J' ai eu les macros ci dessous à effectuer. J'aurai voulu avoir votre avis (ce que j'aurai pu améliorer par exemple ) en ce qui concerne la rédaction de mes macros s'il vous plaît . Merci pour votre aide.

ps : il y a deux macros que je n'ai pas pu terminé car j'avais beaucoup de mal à les visualiser. Si vous pouvez m'aiguillez afin que je puisse comprendre mon erreur. ce serait aimable de votre part.

Merci pour votre aide.

Cordialement

Macro1

Créer une macro qui en ne faisant référence qu'à la cellule A1 de la feuille "Feuil1" qui permet :

- de calculer la somme des 2 valeurs dans la colonne C
- de calculer la différence entre les valeurs de la colonne A et celles de la colonne B dans la colonne D
- d'afficher cette différence en rouge si elle est négative ou en bleu si elle est positive

Le nombre de lignes à traiter n'est pas connu à l'avance

Voici ce que j’ai mis :
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 Sub macro1() Dim somme As Long Dim diff As Long Dim derligne As Long Worksheets("Feuil1").Select derligne = Range("A1").CurrentRegion.End(xlDown).Row - 1 For i = 1 To derligne somme = Range("A1").Offset(i, 0) + Range("A1").Offset(i, 1) Range("A1").Offset(i, 2) = somme diff = Range("A1").Offset(i, 0) - Range("A1").Offset(i, 1) Range("A1").Offset(i, 3) = diff If Range("A1").Offset(i, 3) < 0 Then Range("A1").Offset(i, 3).Font.ColorIndex = 3 _ Else Range("A1").Offset(i, 3).Font.ColorIndex = 5 Next i End Sub
Macro2

Créer la même macro que ci-dessus à l'aide cette fois ci d'une procédure de type "For each…Next"

Voici ce que j’ai mis :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Sub macro2() Dim somme As Long Dim diff As Long Dim maplage As Range Dim cel As Range Dim derligne As Long Worksheets("Feuil1").Select derligne = Range("A1").CurrentRegion.End(xlDown).Row Set maplage = Range("A2:A" & derligne) For Each cel In maplage somme = cel + cel.Offset(0, 1) cel.Offset(0, 2) = somme diff = cel - cel.Offset(0, 1) cel.Offset(0, 3) = diff If cel.Offset(0, 3) < 0 Then cel.Offset(0, 3).Font.ColorIndex = 3 _ Else: cel.Offset(0, 3).Font.ColorIndex = 5 Next End Sub
Macro3

Créer une macro qui vous demande un chiffre entre 1 et 5 et qui affiche dans une fenêtre le message : « Le numéro choisi est : numero ». Cette macro ne devra s’arrêter que lorsque vous aurez saisi une valeur qui ne respecte pas la contrainte. Do until ou do while

Voici ce que j’ai mis :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub macro3() Dim var_nombre As Long Debut_de_la_macro: 'Ceci est une etiquette le goto renvoie le code à cette endroit là var_nombre = InputBox("Tapez un chiffre entre 1 et 5") MsgBox "le numéro tapé est " & var_nombre If var_nombre >= 1 And var_nombre <= 5 Then GoTo Debut_de_la_macro ' End Sub
Macro 4 :
Créer une macro qui permet de compter sur la feuille 2 dans la plage de cellules de la colonne A le nombre de cellules vides. Vous devrez obligatoirement utiliser une procédure de type « For each nexrt »

Macro5

Créer une macro qui permet d’augmenter les prix des articles de la feuille »produit ». le nombre d’articles n’est pas connu
Les articles dont le prix unitaire est inférieur ou égal 50 alors le taux sera de 10 %
Les articles dont le prix unitaire est supérieur à 50 et inférieur ou égal à 100 alors le taux sera de 7 %
Les articles dont le prix unitaire est supérieur à 100 alors le taux sera de 5 %
Le nouveau prix devra être inscrit dans la colonne « F »

Voici ce que j’ai mis :
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 macro5() Dim Taux As Double Dim prix As Double Dim Plage As Range Dim Cellule As Range Derligne = Worksheets("produit").Range("B1").CurrentRegion.End(xlDown).Row Set Plage = Worksheets("produit").Range("B2:B" & Derligne) For Each Cellule In Plage prix = Cellule If Cellule <= 50 Then Taux = 1,1 ElseIf Cellule.Value > 50 And Cellule.Value <= 100 Then Taux = 1,07 ElseIf Cellule > 100 Then Taux = 1,05 Else: Taux = 0 End If Cellule.Offset(0, 1) = Taux Next End Sub
Macro 6
Créer une macro qui devra s’arrêter quad la valeur de la variable « somme » sera supérieur à 300.
la variable « somme » sera augmentée à chaque tour de la valeur de la variable « ajout ».
la valeur de la variable « ajout » sera de 1 au premier tour puis augmentée de 1 à chaque tour.
cependant si la valeur de la variable « ajout » est supérieure à 30, la macro devra s’arrêter.

Bonjour Kiera,

Voici ce que je te propose :

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
Option Explicit
 
Sub macro1_Kiera()
Dim oRange As Range
Dim oCol As Range
Dim i As Integer
 
With Worksheets("Feuil1")
 
    Set oRange = .Range("A1")
    For i = 0 To oRange.CurrentRegion.End(xlDown).Row - 1
        oRange.Offset(i, 2) = oRange.Offset(i, 0) + oRange.Offset(i, 1)
        oRange.Offset(i, 3) = oRange.Offset(i, 0) - oRange.Offset(i, 1)
 
        'Pour les affichages en fonction des valeurs, on peut passer par deux méthodes distinctes :
            '1) Des tests sur les valeurs, tout simplement, comme tu as fait.
            '2) Par l'ajout de mises en forme conditionnelles (pour moi plus propre, car si on change une valeur "à la mano", cela corrige automatiquement)
 
        'Donc 1 ) en passant par des tests sur les valeurs
        If oRange.Offset(i, 3) >= 0 Then
            With oRange.Offset(i, 3)
                .Font.Color = RGB(31, 73, 125)
                .Interior.Color = RGB(141, 180, 227)
            End With
        ElseIf oRange.Offset(i, 3) < 0 Then
             With oRange.Offset(i, 3)
                .Font.Color = RGB(156, 0, 6)
                .Interior.Color = RGB(255, 199, 206)
            End With
        End If
        '######## Fin du 1) ########
    Next i
 
    'Ou 2) en passant par les mises en forme conditionnelles
'    .Cells.FormatConditions.Delete
'
'    Set oCol = Range(oRange.Offset(0, 3), .Columns(4).Find("*", , , , xlByColumns, xlPrevious))
'    With oCol
'        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=0"
'        With .FormatConditions(1)
'                .Font.Color = RGB(31, 73, 125)
'                .Interior.Color = RGB(141, 180, 227)
'
'            .StopIfTrue = False
'        End With
'
'        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=0"
'        With .FormatConditions(2)
'                .Font.Color = RGB(156, 0, 6)
'                .Interior.Color = RGB(255, 199, 206)
'
'            .StopIfTrue = False
'        End With
'    End With
    '######## Fin du 2) ########
End With
 
End Sub
 
Sub macro2_Kiera()
Dim oRange As Range
Dim oCell As Range
 
With Worksheets("Feuil1")
 
    Set oRange = .Range("A1")
    For Each oCell In .Range(oRange, oRange.CurrentRegion.End(xlDown))
        oCell.Offset(0, 2) = oCell + oCell.Offset(0, 1)
        oCell.Offset(0, 3) = oCell - oCell.Offset(0, 1)
 
        If oCell.Offset(0, 3) >= 0 Then
            With oCell.Offset(0, 3)
                .Font.Color = RGB(31, 73, 125)
                .Interior.Color = RGB(141, 180, 227)
            End With
        ElseIf oCell.Offset(0, 3) < 0 Then
             With oCell.Offset(0, 3)
                .Font.Color = RGB(156, 0, 6)
                .Interior.Color = RGB(255, 199, 206)
            End With
        End If
    Next oCell
End With
 
End Sub
 
Sub macro3_Kiera()
'Je ne supporte pas les GoTo.
'Pour moi, il ne faut absolument pas les utiliser, car cela entraine du code dit "spaghetti".
'Ainsi, voici ce que je te propose :
 
Dim resultat
 
Do While True
    resultat = InputBox("Entrez un nombre entier entre 1 et 5", "Valeur à insérer")
    If IsNumeric(resultat) Then
        If resultat - Fix(resultat) = 0 And resultat >= 1 And resultat <= 5 Then
            Exit Do
        End If
    End If
    MsgBox "Le nombre inséré n'est pas un entier entre 1 et 5." & Chr(10) & "Veuillez recommencer."
Loop
 
MsgBox "Le numéro choisi est : " & resultat
 
End Sub
 
Sub macro4_Kiera()
Dim oRange As Range
Dim oCell As Range
Dim compteur As Long
 
compteur = 0
With Worksheets("Feuil2")
    'Je n'ai pas bien compris la limite... Faut-il calculer l'ensemble des cellules de la colonne A (à savoir sur les 1048576 cellules ?
    Set oRange = .Range("A:A")
    For Each oCell In oRange
        If oCell = "" Then
            compteur = compteur + 1
        End If
    Next oCell
End With
 
MsgBox "Le nombre de cellule vide dans la colonne A de la feuille ""Feuil2"" est : " & compteur & "."
 
End Sub
 
Sub macro5_Kiera()
Dim Taux As Double
 
Dim oRange As Range
Dim oCell As Range
 
With Worksheets("produit")
 
    Set oRange = .Range("B1")
    For Each oCell In .Range(oRange.Offset(1, 0), oRange.CurrentRegion.End(xlDown))
 
        If oCell <= 50 Then
            Taux = 1.1
        ElseIf oCell > 50 And oCell <= 100 Then
            Taux = 1.07
        ElseIf oCell > 100 Then
            Taux = 1.05
        End If
 
        oCell.Offset(0, 4) = oCell * Taux
    Next oCell
End With
 
End Sub
 
Sub macro6_Kiera()
'Pas sur d'avoir bien compris...
Dim ajout As Integer
Dim somme As Integer
 
somme = 0
ajout = 1
Do While somme < 300
    somme = somme + ajout
    ajout = ajout + 1
    If ajout > 30 Then
        Exit Do
    End If
Loop
 
MsgBox "Le compteur ""somme"" possède une valeur de : " & somme & "." & Chr(10) & "La variable ""ajout"" possède la valeur de : " & ajout & " (prochaine valeur à ajouter)."
 
End Sub

Je n'ai pas compris ta macro 6.
C'est un compteur automatique ?

N'hésite pas à revenir vers moi pour tout complément ! :ccool:

Cordialement,
Kimy

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub macro1()
'Dim somme As Long
'Dim diff As Long
'Dim derligne As Long
Dim R As Range
Dim i as Long
'Worksheets("Feuil1").Select
'derligne = Range("A1").CurrentRegion.End(xlDown).Row - 1
Set R = Worksheets("Feuil1").Range("A1").CurrentRegion
For i = 1 To R.Rows.Count
         'somme = Range("A1").Offset(i, 0) + Range("A1").Offset(i, 1)
         'Range("A1").Offset(i, 2) = somme
          R(i, 3).Value = R(i, 1).Value + R(i, 2).Value
         'diff = Range("A1").Offset(i, 0) - Range("A1").Offset(i, 1)
         'Range("A1").Offset(i, 3) = diff
         R(i, 4).Value = R(i, 1).Value - R(i, 2).Value
         If R(i, 4) < 0 Then R(i, 4).Font.ColorIndex = 3 Else R(i, 4).Font.ColorIndex = 5
         'If Range("A1").Offset(i, 3) < 0 Then Range("A1").Offset(i, 3).Font.ColorIndex = 3 _
         'Else Range("A1").Offset(i, 3).Font.ColorIndex = 5
Next
End Sub

Bonjour Kiera et Kimy_Ire et rdurupt et ... tout le monde

Personellement j'utilise l'objet "Sheets" et pas "Worksheets" Même si cela fait le même résultat c'est plus court et lorsque l'on utilise la assistant de macro il utilise "Sheets"
J'utilise aussi beaucoup l'Objet "Cells" qui est a mon avis plus pratique que l'Objet Range surtout quand on change de cellule comme c'est ton cas, et je n'aime pas .Offset également :aie:

ATTENTION : Certaines de tes macros ne respectent pas les consignes comme c'est le cas de la macro3 tu dois utiliser Do...While ou Do... Until (c'est toi-même qui le dit) ;)

J'ai pris la liberté de faire une proposition pour la macro 4 et 6 qui te pose un problème

et aussi la fonction Select Case me parrait plus adéquat que tes If imbriqués dans la macro5

Concernant tes Macro1 et 2,elles me paraissent correcte mais dans le but d'une amélioration je te fais quelques proposition
De plus Kimy_Ire et rdurupt t'ont fait des remarques interessantes

Voici donc mes propositions

n'hesites pas a posé des questions sur ce que tu ne comprendrais pas

A Bientôt

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
'Créer une macro qui en ne faisant référence qu'à la cellule A1 de la feuille "Feuil1" qui permet :
'- de calculer la somme des 2 valeurs dans la colonne C
'- de calculer la différence entre les valeurs de la colonne A et celles de la colonne B dans la colonne D
'- d'afficher cette différence en rouge si elle est négative ou en bleu si elle est positive
'Le nombre de lignes à traiter n'est pas connu à l'avance
Sub macro1()
    ' l'Objet Cells(N° de ligne, N° de colonne) permet de facilement se déplacer d'une colonne ou d'une ligne
    ' en faisant incrémenter des variables ce qui simplifie la programmation
    Dim i As Long
 
    Sheets("Feuil1").Select
    Range("A1").Select
    For i = 1 To Cells.End(xlDown).Row
        Cells(i, 3).Value = Cells(i, 1).Value + Cells(i, 2).Value ' somme
        Cells(i, 4).Value = Cells(i, 1).Value - Cells(i, 2).Value ' différence
        If Cells(i, 4).Value < 0 Then
            Cells(i, 4).Font.ColorIndex = 3
        Else
            Cells(i, 4).Font.ColorIndex = 5
        End If
    Next i
End Sub
 
 
'Créer une macro qui vous demande un chiffre entre 1 et 5 et qui affiche dans une fenêtre le message :
'« Le numéro choisi est : numero ».
'Cette macro ne devra s’arrêter que lorsque vous aurez saisi une valeur qui ne respecte pas la contrainte.
'Do until ou do while
Sub macro3()
    Dim Var_Nombre As Long
    Var_Nombre = 0
    Do
        Var_Nombre = InputBox("Tapez un chiffre entre 1 et 5")
    Loop While Var_Nombre < 1 Or Var_Nombre > 5
 
    MsgBox "Le numéro choisi est : " & Var_Nombre, vbInformation + vbOKOnly
 
End Sub
 
 
'Créer une macro qui permet de compter sur la feuille 2 dans la plage de cellules de la colonne A
'le nombre de cellules vides.
'Vous devrez obligatoirement utiliser une procédure de type « For each next »
Sub macro4()
    'en suposant que le nombre maximum de ligne est : 65536 (version jusqu'à 2003)
    Dim Tot_Vid As Long
    Tot_Vid = 0
    Sheets("Feuil2").Select
    Set maplage = Range("A1:A65536")
    For Each cel In maplage
        If cel.Value = "" Then
            Tot_Vid = Tot_Vid + 1
        End If
    Next
    MsgBox "Nbre de cellules vide : " & Tot_Vid, vbInformation
End Sub
 
 
'Créer une macro qui permet d’augmenter les prix des articles de la feuille »produit ».
'le nombre d’articles n’est pas connu
'Les articles dont le prix unitaire est inférieur ou égal 50 alors le taux sera de 10 %
'Les articles dont le prix unitaire est supérieur à 50 et inférieur ou égal à 100 alors le taux sera de 7 %
'Les articles dont le prix unitaire est supérieur à 100 alors le taux sera de 5 %
'Le nouveau prix devra être inscrit dans la colonne « F »
Sub macro5()
    Dim Taux As Single
    Dim Lign As Long        'N°de ligne ou se trouve le Premier Prix
    Dim Coln As Integer     'N°de Colonne ou se trouve les Prix
 
    ' Je suppose que le premier prix est en B2
    Lign = 2
    Coln = 2
    Sheets("produit").Select
    Do
        Select Case Cells(Lign, Coln).Value
            Case Is <= 50
                Taux = 1 + 1 * (10 / 100)
            Case 50 To 100
                Taux = 1 + 1 * (7 / 100)
            Case Is > 100
                Taux = 1 + 1 * (5 / 100)
        End Select
        Cells(Lign, 6).Value = Cells(Lign, Coln).Value * Taux
        Lign = Lign + 1
    Loop While Cells(Lign, 1).Value <> ""
End Sub
 
 
'Créer une macro qui devra s’arrêter quand la valeur de la variable « somme » sera supérieur à 300.
'la variable « somme » sera augmentée à chaque tour de la valeur de la variable « ajout ».
'la valeur de la variable « ajout » sera de 1 au premier tour puis augmentée de 1 à chaque tour.
'cependant si la valeur de la variable « ajout » est supérieure à 30, la macro devra s’arrêter.
Sub macro6()
    Dim Somme As Integer
    Dim Ajout As Integer
    Dim Mess As String      'Construction du message final
 
    Somme = -200
    Ajout = 1
    Do
        Somme = Somme + Ajout
        Ajout = Ajout + 1
        If Ajout > 30 Then
            Exit Do
        End If
    Loop While Somme <= 300
    Mess = "Somme : " & Somme & vbCrLf & "Ajout : " & Ajout
    MsgBox Mess, vbInformation, "Résultat"
End Sub

PS: n'oublie pas d'indenté tes macros cela les rends plus lisible

27/01/2015, 21h01
clementmarcotte

Bonjour,

Citation:

Envoyé par Igloobel

Bonjour Kiera et Kimy_Ire et rdurupt et ... tout le monde ]

Personellement j'utilise l'objet "Sheets" et pas "Worksheets" Même si cela fait le même résultat c'est plus court et lorsque l'on utilise la assistant de macro il utilise "Sheets"

Je n'ai pas tout lu, loin de là, mais juste une petite précision. Les objets sheet et Worksheet sont à la fois pareils et différents. L'objet sheet est une feuille au sens Excel du terme. Cela peut être une feuille de calcul, une feuille graphique, une feuille de macro XL5 et tout ce qu'Excel peut considérer comme une feuille. L'objet Worksheet, se limite uniquement ce qu'Excel peut considérer comme étant une feuille de calcul. Donc, une Worksheet est une Sheet et une sheet n'est pas forcément une Worksheet.

Tant qu'un classeur ne contient que des feuilles de calcul, on peut utiliser les deux objets indifféremment. Mais, dans le cas d'un classeur avec 3 feuilles de calcul et une feuille de macros, il y a 4 Sheet(s) et 3 Worksheet(s).
28/01/2015, 08h29
Igloobel

Bonjour à Tous

Merci clementmarcotte pour cette précision de je ne connaissait pas :aie:

Comme quoi on en apprend tous les jours :mouarf:

:ccool:

A+
28/01/2015, 10h26
Kimy_Ire

Citation:

Envoyé par clementmarcotte

Bonjour,

Je n'ai pas tout lu, loin de là, mais juste une petite précision. Les objets sheet et Worksheet sont à la fois pareils et différents. L'objet sheet est une feuille au sens Excel du terme. Cela peut être une feuille de calcul, une feuille graphique, une feuille de macro XL5 et tout ce qu'Excel peut considérer comme une feuille. L'objet Worksheet, se limite uniquement ce qu'Excel peut considérer comme étant une feuille de calcul. Donc, une Worksheet est une Sheet et une sheet n'est pas forcément une Worksheet.

Tant qu'un classeur ne contient que des feuilles de calcul, on peut utiliser les deux objets indifféremment. Mais, dans le cas d'un classeur avec 3 feuilles de calcul et une feuille de macros, il y a 4 Sheet(s) et 3 Worksheet(s).

Bon, idem que Igloobel, je ne connaissais pas la différence. Merci ! :ccool:
01/02/2015, 01h11
Kiera

Bonsoir ,
je remercie chacun d'entre vous pour vos réponses.

Par contre je me suis rendue compte d'une erreur lorsque j'ai posté la consigne de la macro3.
En effet , j'ai rajouté les instructions " Do until ou do while" à la fin, sauf que cela ne fait pas partie de la consigne mais d'une remarque que j'avais inscrite à titre personnel ( et j'ai oublié de retirer cette indication).

La consigne étant :
Créer une macro qui vous demande un chiffre entre 1 et 5 et qui affiche dans une fenêtre le message : « Le numéro choisi est : numero ». Cette macro ne devra s’arrêter que lorsque vous aurez saisi une valeur qui ne respecte pas la contrainte.[~~B] Do until ou do while[/B]~~

Je me demandais donc si ma macro était quand même valable?

Je pense avoir une petite idée, mais j'aimerai bien avoir votre avis pour connaître mon erreur. (je pense qu'il y a un bug vers la fin de ma macro)

Encore merci.

Cordialement.
01/02/2015, 14h00
Igloobel

effectivement il y a un bug ... ta macro remonte si on saisie 1 ou 2 ou 3 ou 4 ou 5 par contre si on saisie autre chose on sort (en fait elle fonctionne a l'envers)

regarde mon poste je t'ai fait toute les modification de chacune de tes macros (sauf la 2)

A+