Aide pour raccourcir un peu formule macro

jeromeN95 · 15 Décembre 2011

Bonsoir a tous,
je ne connais pas trop l'univer des Macro et lorsque je modifie mon code pour le raccourcir, il ne fonctionne plus.
Pourriez vous m'aidez à comprendre comment le raccourcir SVP ? :

Code:

' changement mode
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plage As Range, Intersection As Range
    Set Plage = Range("I1:T1")
    Set Intersection = Intersect(Target, Plage)
    If Not (Intersection Is Nothing) Then
If Not Application.Intersect(Target, Range("I1")) Is Nothing Then
If [I1] = "Manuel/Formule (Valid Verrouiller)" Then
    If [A3] <> "" Then
    Range("R6").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R6").Select
    ActiveCell.FormulaR1C1 = ""
    End If
    
    If [A7] <> "" Then
    Range("R10").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R10").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A11] <> "" Then
    Range("R14").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R14").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A15] <> "" Then
    Range("R18").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R18").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A19] <> "" Then
    Range("R22").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R22").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A23] <> "" Then
    Range("R26").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R26").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A27] <> "" Then
    Range("R30").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R30").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A31] <> "" Then
    Range("R34").Select
    ActiveCell.FormulaR1C1 = "1"
        Else
    Range("R34").Select
    ActiveCell.FormulaR1C1 = ""
        End If

End If
If [I1] = "Drain/Séquentiel (Vidange)" Then
    If [A3] <> "" Then
    Range("R6").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R6").Select
    ActiveCell.FormulaR1C1 = ""
    End If
    
    If [A7] <> "" Then
    Range("R10").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R10").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A11] <> "" Then
    Range("R14").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R14").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A15] <> "" Then
    Range("R18").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R18").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A19] <> "" Then
    Range("R22").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R22").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A23] <> "" Then
    Range("R26").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R26").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A27] <> "" Then
    Range("R30").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R30").Select
    ActiveCell.FormulaR1C1 = ""
        End If
        
    If [A31] <> "" Then
    Range("R34").Select
    ActiveCell.FormulaR1C1 = "3"
        Else
    Range("R34").Select
    ActiveCell.FormulaR1C1 = ""
        End If

End If
Range("C3").Select
End If
End If
End Sub

De plus, j'aimerai lancer cette macro également dans les plages :
I1, I36, I71, I106, I141 et I176

Dans les codes ci dessus, ca ne concerne actuellement que la plage I1.
Mais chaques "groupes de code" doivent aussi y faire appel.
Les formules modifier sont :
I1 - - I36 - - I71 - - I106 - - I141 - - I176

Pour les plages ci dessous.
R6-- R41-- R76-- R111-- R146-- R181--
R10-- R45-- R80-- R115-- R150-- R185--
R14-- R49-- R76-- R119-- R154-- R189--
R18-- R53-- R88-- R123-- R158-- R193--
R22-- R57-- R92-- R127-- R162-- R197--
R26-- R61-- R96-- R131-- R166-- R201--
R30-- R65-- R100-- R135-- R170-- R205--
R34-- R69-- R104-- R139-- R174-- R209--
Donc I1 dans tout le code collé, modifie les cellules :
R6
R10
R14
R18
R22
R26
R30
R34

Il faudrait m'aider pour faire la même chose sur les 5 autres plages SVP mais sans faire 15 pages de codes...

Merci.

mapomme · 15 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Bonsoir jeromeN95,

Multipliez vos chances de réponses, joignez un fichier.

Staple1600 · 15 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Bonsoir à tous

Code:

Range("R6").Select
    ActiveCell.FormulaR1C1 = "1"

peut s'écrire

Code:

Range("R6")= "1"

mais aussi

Code:

[R6]= "1"

(régime à appliquer aux lignes similaires à celle-ci dans ton code)
cela fait , ton code aura déjà subi un amaigrissement certain.

PS: je plussoie à la suggestion de mapomme

jeromeN95 · 16 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Merci beaucoup pour ces réponses rapides.

julberto · 16 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Bonjour jeromeN95,bonjour le fil

Si cette macro répond à ta question, il est fort probable que celle-ci ne réponde pas à ton attente (ne manquerait-il pas un fichier joint pour nous guider ?).

VB:

Option Explicit
'http://www.excel-downloads.com/forum/174959-aide-pour-raccourcir-un-peu-formule-macro.html
' changement mode
Private Sub Worksheet_Change(ByVal Target As Range)
    
Dim i As Integer, j As Integer, sst As String, indx As Integer

If Not Application.Intersect(Target, Columns("I")) Is Nothing Then
   indx = Target.Row
      If (indx + 35) Mod 35 <> 1 Then Exit Sub
      If Target.Value = "Manuel/Formule (Valid Verrouiller)" Then
         sst = "1"
      ElseIf Target.Value = "Drain/Séquentiel (Vidange)" Then
         sst = "3"
      Else
         Exit Sub
      End If
         j = indx + 5
      For i = 3 To 31 Step 4
         If Range("A" & i) <> "" Then Range("R" & j) = sst Else Range("R" & j) = ""
         j = j + 4
      Next i
      Range("C3").Select
End If

End Sub

cordialement

jeromeN95 · 17 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Bonjour le forum,
Bonjour julberto,
Je dois dire que j'ai été ravi lorsque j'ai testé cette macro au début,
ensuite j'ai été frustrer de voir avec qu'elle insollence cela répond a mes attentes.

Merci beaucoup pour tout cela...

Bonne journée.

jeromeN95 · 17 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Au passage, j'ai un piti soucci avec une colo de cellule :

HTML:

[CODE]Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("U3:U10", "U38:U45")) Is Nothing Then
With Target
If Selection.Interior.ColorIndex = 36 Then
Selection.Interior.ColorIndex = 34
Else
Selection.Interior.ColorIndex = 36
End If
End With
End If
End Sub[/CODE]

Je souhaite colorer en jaune les cellules U3 à U10 lors d'un premier clic, et colorer en bleu lors d'un second click.
Ca, ça fonctionne mais avec la virgule, ca ne marche plus :

Code:

U3:U10", "U38:U45/CODE]
En faite, j'aimerai même que ce principe fonctionne également avec ces plages :
U3:U10
U38:U45
U73:80
U108:115
U143:150
U178:185

Staple1600 · 17 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Bonsoir à tous

et ainsi, cela donne quoi ?

If Not Application.Intersect(Target, Range("U3:U10,U38:U45")) Is Nothing Then

julberto · 18 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Bonjour jeromeN95,
Bonjour mapomme,Staple1600

1- Comme le dit Staple1600, trop de double quote nuit....
2 - Pour éviter que le basculement bleu/jaune ne s'effectue sur des cellules non désirées, j'ai rajouté

Target.Cells.Count

Pour l'observer sélectionne les cellules U1:U5 et juge par toi même l'opportunité de ce rajout.

VB:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Myrange As Range

Set Myrange = Range("U3:U10,U38:U45,U73:U80,U108:U115,U143:U150,U178:U185")
If Application.Intersect(Target, Myrange) Is Nothing Or Target.Cells.Count <> 1 Then Exit Sub

With Target.Interior
   If .ColorIndex = 36 Then .ColorIndex = 34 Else .ColorIndex = 36
End With

End Sub

cordialement

jeromeN95 · 19 Décembre 2011

Re : Aide pour raccourcir un peu formule macro

Bonsoir a tous,
Merci julberto, c est parfait.
Je comprend l interet du target cells count.

Bonne soiree a vous tous et que bill benisse ce forum!

Aide pour raccourcir un peu formule macro

jeromeN95

XLDnaute Impliqué

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

jeromeN95

XLDnaute Impliqué

julberto

XLDnaute Occasionnel

jeromeN95

XLDnaute Impliqué

jeromeN95

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

julberto

XLDnaute Occasionnel

jeromeN95

XLDnaute Impliqué

Discussions similaires

Aide pour raccourcir un peu formule macro

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Occasionnel

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency