Aide pour raccourcir un peu formule macro

jeromeN95

jeromeN95

XLDnaute Impliqué
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.
 
Dernière édition:
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
J

julberto

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
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.
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
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
 
Dernière édition:
Vote positif 0 Vote négatif
J

julberto

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2021 Aide pour affichage colonne listbox après une recherche par textbox
Réponses
10
Affichages
299
Claudinedu13
C
U
  • Question
Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement
Réponses
11
Affichages
449
un internaute
U
Lu76Fer
  • Question
XL 2016 Notation Simplifiée pour définir un tableau arborescent
Réponses
9
Affichages
618
Lu76Fer
Lu76Fer
L
  • Résolu(e)
Microsoft 365 Changer code pour sélectionner 3lignes avec un pas de 1
Réponses
4
Affichages
330
laplayast
L
G
  • Question
Microsoft 365 Aide pour formule qui ne fonctionne pas.
Réponses
8
Affichages
500
TooFatBoy
TooFatBoy
Usine à gaz
  • Résolu(e)
XL 2021 touches Ctrl+R pour revenir
Réponses
4
Affichages
327
TooFatBoy
TooFatBoy
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
666
Oneida
Oneida
U
  • Question
Autres [RÉSOLU] Pour faire afficher colonne F par double clic dans tout le classeur
Réponses
3
Affichages
378
vgendron
vgendron
Yann71
  • Question
XL 2019 Ajouter un " aperçu avant impression " à ce code
Réponses
7
Affichages
665
Yann71
Yann71
PoloTaz67
  • Question
XL 2019 Aide pour un code
Réponses
1
Affichages
333
Compte Supprimé 979
C

Membres actuellement en ligne

18 membres et 286 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 485
Messages
2 088 802
Membres
103 971
dernier inscrit
abdazee