Optimiser Select Case

Version imprimable

Rebonsoir les experts d’Excel,

Une autre petite question s’il vous plait …

Mon code If Then inclut plusieurs Select.Case et il est tellement long que lorsque de l’utilisation une erreur 28 espace pile insuffisant se produise ou erreur d’exécution « Value de l’objet range a échoué 2147417840 (80010108).
Lorsque j’essaie de résoudre ce problème dans le code, je vois que VBA souligne la partie dont voici un exemple. Ici il souligne la ligne avec la cellule D10 mais chaque fois le numéro de cellule change (H10, L10 etc) et voici l'exemple de code souligné:

Code:

Case Else: Range("D10").Value = "" ()

Le code que j'utilise:

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
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Address = "$C$10" Then
        Select Case Target.Value
            Case 0.03: Range("C11").Value = 0.028
                       Range("C18").Value = 1.05
            Case 0.04: Range("C11").Value = 0.028
                       Range("C18").Value = 1.4
 
 
              ElseIf Target.Address = "$D$10" Then
        Select Case Target.Value
               Case 0.04: Range("D11").Value = 0.028
               Case 0.045: Range("D11").Value = 0.028
               Case 0.06: Range("D11").Value = 0.028
               Case 0.075: Range("D11").Value = 0.027
               Case 0.08: Range("D11").Value = 0.027
               Case 0.09: Range("D11").Value = 0.027
               Case 0.1: Range("D11").Value = 0.027
               Case 0.105: Range("D11").Value = 0.027
        Case Else: Range("D10").Value = ""
           Range("D11").Value = ""
       End Select
 
 
 
        ElseIf Target.Address = "$E$10" Then
        Select Case Target.Value
               Case 0.04: Range("E11").Value = 0.028
               Case 0.045: Range("E11").Value = 0.028
               Case 0.06: Range("E11").Value = 0.028
               Case 0.075: Range("E11").Value = 0.027
               Case 0.08: Range("E11").Value = 0.027
               Case 0.09: Range("E11").Value = 0.027
               Case 0.1: Range("E11").Value = 0.027
               Case 0.105: Range("E11").Value = 0.027
        Case Else: Range("E10").Value = ""
           Range("E11").Value = ""
       End Select

Comme vous pouvez constater j’utilise la même condition pour ma cellule Target D10 avec case D11 ainsi que pour la cellule Target E10 avec case E11.
Je répète chaque fois le même code jusqu’à la cellule J10 en modifiant donc que les cellules.
Je voudrais donc savoir si je peux regrouper mes codes dans une seule condition et éviter ainsi l’erreur 28.

Mon essai qui ne fonctionne pas :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
  ElseIf Target.Address = "$D$10 : $J$10" Then
        Select Case Target.Value
               Case 0.04: Range("D11 :J11").Value = 0.028
               Case 0.045: Range("D11 :J11").Value = 0.028
               Case 0.06: Range("D11 :J11").Value = 0.028
               Case 0.075: Range("D11 :J11").Value = 0.027
               Case 0.08: Range("D11 :J11").Value = 0.027
               Case 0.09: Range("D11 :J11").Value = 0.027
               Case 0.1: Range("D11 :J11").Value = 0.027
               Case 0.105: Range("D11 :J11").Value = 0.027
        Case Else: Range("D10 :J11").Value = ""
           Range("D11 :J11").Value = ""
       End Select

Pourriez-vous m’aider une fois de plus svp ? :oops:

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Count = 1 Then
    Application.EnableEvents = False
    Select Case Target.Address
    Case "$C$10"
        Select Case Target.Value
        Case 0.03
            Range("C11").Value = 0.028
            Range("C18").Value = 1.05
        Case 0.04
            Range("C11").Value = 0.028
            Range("C18").Value = 1.4
        End Select
 
    Case "$D$10", "$E$10", "$F$10", "$G$10", "$H$10", "$I$10", "$J$10"
        Select Case Target.Value
        Case 0.04, 0.045, 0.06
            Target.Offset(1).Value = 0.028
        Case 0.075, 0.08, 0.09, 0.1, 105
            Target.Offset(1).Value = 0.027
        Case Else
            Target.Offset(1).Value = ""
        End Select
    End Select
    Application.EnableEvents = True
End If
End Sub

Bonjour Mercatog,

J'ai testé le code et ça fonctionne super bien ! Merci encore !
J'ai donc décidé de terminer ce code jusqu'la fin en ajoutant 2 mêmes codes de suite et 2 petites formules :oops: et le code ne fonctionne plus. Je pense que j'ai fait une erreur avec Else If ou Select Case en ajoutant ces codes.

Sans profiter de votre gentillesse, pourriez-vous me donner un signe de mon erreur svp ? :oops: Je vais y arriver je sais:D

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Count = 1 Then
    Application.EnableEvents = False
    Select Case Target.Address
    Case "$C$10"
        Select Case Target.Value
        Case 0.03
            Range("C11").Value = 0.028
            Range("C18").Value = 1.05
        Case 0.04
            Range("C11").Value = 0.028
            Range("C18").Value = 1.4
        Case 0.04:
            Range("C11").Value = 0.028
            Range("C18").Value = 1.4
                End Select
 
 
   Case "$D$10", "$E$10", "$F$10", "$G$10", "$H$10", "$I$10", "$J$10"
        Select Case Target.Value
        Case 0.04, 0.045, 0.06
            Target.Offset(1).Value = 0.028
        Case 0.075, 0.08, 0.09, 0.1, 0.105
            Target.Offset(1).Value = 0.027
        Case Else
            Target.Offset(1).Value = ""
       End Select
    End Select
 
 
    Case "$D$14", "$E$14", "$F$14", "$G$14", "$H$14", "$I$14", "$J$14"
        Select Case Target.Value
        Case 0.02, 0.03, 0.04, 0.045, 0.06
            Target.Offset(1).Value = 0.028
        Case 0.075, 0.08, 0.09
            Target.Offset(1).Value = 0.027
        End Select
     End Select
 
 
    Case "$D$16", "$E$16", "$F$16", "$G$16", "$H$16", "$I$16", "$J$16"
        Select Case Target.Value
        Case 0.02, 0.03, 0.04, 0.045, 0.06
            Target.Offset(1).Value = 0.028
        Case 0.075, 0.08, 0.09
            Target.Offset(1).Value = 0.027
        End Select
     End Select
 
    Application.EnableEvents = True
 
'Calcul K
 
ElseIf Not Application.Intersect(Target, Range("D10:J12 ")) Is Nothing Then
    If [D12] <> 0 Then [D12] = [D10] / [D11]
    If [E12] <> 0 Then [E12] = [E10] / [E11]
    If [F12] <> 0 Then [F12] = [F10] / [F11]
    If [G12] <> 0 Then [G12] = [G10] / [G11]
    If [H12] <> 0 Then [H12] = [H10] / [H11]
    If [I12] <> 0 Then [I12] = [I10] / [I11]
    If [J12] <> 0 Then [J12] = [J10] / [J11]
 
 
ElseIf Not Application.Intersect(Target, Range("D16:J18 ")) Is Nothing Then
    If [D17] <> 0 Then [D18] = [D15] + [D17]
    If [E17] <> 0 Then [E18] = [E15] + [E17]
    If [F17] <> 0 Then [F18] = [F15] + [F17]
    If [G17] <> 0 Then [G18] = [G15] + [G17]
    If [H17] <> 0 Then [H18] = [H15] + [H17]
    If [I17] <> 0 Then [I18] = [I15] + [I17]
    If [J17] <> 0 Then [J18] = [J15] + [J17]
 
 
    End If
End Sub

26/04/2014, 12h48
Philippe Tulliez
Bonjour,
Ton problème depuis le début vient du fait que tu ne comprends pas la syntaxe des Select Case, If then Else etc...
Lorsque tu fais un Select Case, celui-ci doit se terminer par End Select et à l'intérieur de ce bloc on teste par une suite de Case et éventuellement comme dernier test un Case Else
Soit
Code:

1 2 3 4 5 6 Select [ Case ] testexpression [ Case expressionlist [ statements ] ] [ Case Else [ elsestatements ] ] End Select
Or dans ta procédure, tu ferme en ligne 17, le Select Case commencé en ligne 5 (Select Case Target.Address) et tu continues en ligne 32 avec une ligne

Code:

Case "$D$10", "$E$10", "$F$10", "$G$10", "$H$10", "$I$10", "$J$10"

et ainsi de suite.
Il serait bon que tu lises un tutoriel par exemple http://bidou.developpez.com/article/VBA/ et tout particulièrement le chapitre Structure décisionnelle

Bonjour Philippe,

Merci pour vos remarques, je viens justement de télécharger ce manuel il y a quelques jours et je vais lire avec grande attention. J'ai refait des tests et mon code fonctionne. Et voici ce code complet pour ceux qui auront besoin un jour :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count = 1 Then
    Application.EnableEvents = False
    Select Case Target.Address
    Case "$C$10"
        Select Case Target.Value
        Case 0.03
            Range("C11").Value = 0.028
            Range("C18").Value = 1.05
        Case 0.04
            Range("C11").Value = 0.028
            Range("C18").Value = 1.4
                End Select
 
    Case "$D$10", "$E$10", "$F$10", "$G$10", "$H$10", "$I$10", "$J$10"
        Select Case Target.Value
        Case 0.04, 0.045, 0.06
            Target.Offset(1).Value = 0.028
        Case 0.075, 0.08, 0.09, 0.1, 105
            Target.Offset(1).Value = 0.027
        Case Else
            Target.Offset(1).Value = ""
        End Select
 
    Case "$D$14", "$E$14", "$F$14", "$G$14", "$H$14", "$I$14", "$J$14"
        Select Case Target.Value
        Case 0.02, 0.03, 0.04, 0.045, 0.06
            Target.Offset(1).Value = 0.028
        Case 0.075, 0.08, 0.09
            Target.Offset(1).Value = 0.027
        End Select
 
    Case "$D$16", "$E$16", "$F$16", "$G$16", "$H$16", "$I$16", "$J$16"
        Select Case Target.Value
        Case 0.02, 0.03, 0.04, 0.045, 0.05, 0.06
            Target.Offset(1).Value = 0.028
        Case 0.07, 0.075, 0.08, 0.09
            Target.Offset(1).Value = 0.027
        End Select
    End Select
    Application.EnableEvents = True
 
End If
End Sub

J'essais maintenant d'intégrer mes deux formules à l'intérieur de ce code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
ElseIIf Not Application.Intersect(Target, Range("D10:J12 ")) Is Nothing Then
    If [D12] <> 0 Then [D12] = [D10] / [D11]
    If [E12] <> 0 Then [E12] = [E10] / [E11]
    If [F12] <> 0 Then [F12] = [F10] / [F11]
    If [G12] <> 0 Then [G12] = [G10] / [G11]
    If [H12] <> 0 Then [H12] = [H10] / [H11]
    If [I12] <> 0 Then [I12] = [I10] / [I11]
    If [J12] <> 0 Then [J12] = [J10] / [J11]
 
 
ElseIf Not Application.Intersect(Target, Range("D16:J18 ")) Is Nothing Then
    If [D17] <> 0 Then [D18] = [D15] + [D17]
    If [E17] <> 0 Then [E18] = [E15] + [E17]
    If [F17] <> 0 Then [F18] = [F15] + [F17]
    If [G17] <> 0 Then [G18] = [G15] + [G17]
    If [H17] <> 0 Then [H18] = [H15] + [H17]
    If [I17] <> 0 Then [I18] = [I15] + [I17]
    If [J17] <> 0 Then [J18] = [J15] + [J17]

J'espère je vais y arriver ....:roll:
à+

26/04/2014, 16h05
mercatog

Tu n'es pas entrain de te créer une usine à gaz?

Pourquoi ne pas utiliser de simples formules sur ta feuille qui seront adaptés automatiquement en utilisant une feuille supplémentaire contenant la correspondance entre valeurs.

Ecrire en dur des données dans un code est déconseillé
26/04/2014, 16h17
tatbud304

Bonjour Mercatog,

En effet, je voudrais bien utiliser les simples formules dans la feuil de calcul mais j'ai une procédure contenant la méthode ClearContents. En commençant un nouveau projet je vide des anciens données avec le bouton et Excel me vide les formules avec les données alors que ne devrait pas finalement. C'est pour cela que j'ai voulu écrire ces formules en VBA..:oops:
26/04/2014, 16h28
Philippe Tulliez

Bonjour,

Si tu expliquais en quelques mots ce que tu veux réaliser ?

Pour partir d'une feuille ou d'un classeur vide de données mais avec les formules et formats déjà présents, tu peux partir d'un classeur modèle (suffixé xlt ou xltx) ou bien partir d'une feuille présente dans le classeur de travail que tu recopies en débutant une procédure ou bien encore prévoir une plage nommées qui contiendrait les cellules contenant les données (pas les formules) et sur laquelle tu utiliserais la méthode ClearContents
26/04/2014, 16h53
mercatog

On peut vider seulement les cellules ne contenant pas de formules

Code:

Feuil1.UsedRange.SpecialCells(xlCellTypeConstants).ClearContents

Toutes les cellules seront effacées excepté celles contenant des formules (càd les formules seront épargnées)
26/04/2014, 20h57
tatbud304

Philippe !

Avec le classeur modèle les formules restent ! :) Merci !

Mercatog !

Votre code fonctionne aussi ! Merci !

Enfin tout fonctionne ! Merci encore à vous deux de m'avoir aidé ! :resolu::D