Réduire un code

[Ilino]

Bonsoir Forum
ci dessous mon code , je souhaite le minimiser est t'il possibl ???

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [AH12] = "" Then [AH12] = "En cours"
If [AH16] = "" Then [AH16] = "En cours"
If [AH18] = "" Then [AH18] = "En cours"
If [AH20] = "" Then [AH20] = "En cours"
If [AH26] = "" Then [AH26] = "En cours"
If [AH28] = "" Then [AH28] = "En cours"
If [AH30] = "" Then [AH30] = "En cours"
If [AH32] = "" Then [AH32] = "En cours"
If [AH34] = "" Then [AH34] = "En cours"
If [AH36] = "" Then [AH36] = "En cours"
If [AH38] = "" Then [AH38] = "En cours"
If [AH40] = "" Then [AH40] = "En cours"
If [AH42] = "" Then [AH42] = "En cours"
If [AH46] = "" Then [AH46] = "En cours"
If [AH48] = "" Then [AH48] = "En cours"
If [AH52] = "" Then [AH52] = "En cours"
If [AH54] = "" Then [AH54] = "En cours"
If [AH58] = "" Then [AH58] = "En cours"
If [AH60] = "" Then [AH60] = "En cours"
If [AH62] = "" Then [AH62] = "En cours"
If [AH66] = "" Then [AH66] = "En cours"

End Sub

A+

 

[Victor21]

Re : Réduire un code

Bonsoir, Ilino.

Un fichier joint nous aurait permis de voir ce qu'il y a entre AH12 et AH16, entre AH16 et AH18, entre...
et d'adapter nos éventuelles propositions au plus juste, mais je suppose qu'après 1326 messages, je ne vous apprends rien, et que vous avez juste oublié de le joindre 😉

 

[Ilino]

Re : Réduire un code

Bonsoir PATRICK
Merci pour la remarque , mais entre ces cellules il ya rien (que des cellules vide ) c'est pour cette raison j'ai pas fait un fichier joint 😱 GRAZIE
A+

 

[DoubleZero]

Re : Réduire un code

Bonjour, Ilino, Victor21 😀, le Forum,

...Un fichier joint nous aurait permis...

Comme d'habitude 🙄...

Une suggestion, avec ce code placé dans le module de l'onglet concerné :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal c As Range)
    Dim plage As Range
    Set plage = Range("AH12,AH16,AH18,AH20,AH26,AH28,AH30,AH32,AH34,AH36,AH38,AH40,AH42,AH46,AH48,AH52,AH54,AH58,AH60,AH62,AH66")
    For Each c In plage
        If c = "" Then c = "En cours"
    Next
End Sub

A bientot 🙂

 

[Ilino]

Re : Réduire un code

Bonsoir Double zero
GRAZIE pour la réponse ça fonctionne tres bien
PBLM resolved
A+

 

[job75]

Re : Réduire un code

Bonsoir Ilino,

2 solutions parmi d'autres :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Set r = [AH12,AH16,AH18,AH20,AH26,AH28,AH30,AH32,AH34,AH36,AH38,AH40,AH42,AH46,AH48,AH52,AH54,AH58,AH60,AH62,AH66]
For Each r In r
  If r = "" Then r = "En cours"
Next
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a, i
a = Array(12, 16, 18, 20, 26, 28, 30, 32, 34, 36, 38, 40, 42, 46, 48, 52, 54, 58, 60, 62, 66)
For i = 0 To UBound(a)
  If Range("AH" & a(i)) = "" Then Range("AH" & a(i)) = "En cours"
Next
End Sub

A+

 

[Ilino]

Re : Réduire un code

Bonsoir JOB
Encore grazie 😎
A+

 

[job75]

Re : Réduire un code

Re,

Autre solution :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a, i
a = Array(14, 22, 24, 44, 50, 56, 64)
For i = 12 To 66 Step 2
  If IsError(Application.Match(i, a, 0)) And _
    Range("AH" & i) = "" Then Range("AH" & i) = "En cours"
Next
End Sub

Edit : impardonnable, je n'avais pas vu 00, bonsoir chère ânesse 🙂

A+

 

[DoubleZero]

Re : Réduire un code

Re-bonjour, bonjour, job75 😀,

... impardonnable, je n'avais pas vu 00, bonsoir chère ânesse...

impardonnable 😕 ?

Absolument pas : j'avais "chaussé mes petits chaussons" pour venir sans faire trop de vacarme avec mes gros sabots 😉 !

Bon dodo et à bientôt 😀😀