XL 2010 Optimiser une macro permettant de lancer des macro

P

pompier83

XLDnaute Nouveau
bonjour à tous j'ai creer une macro qui fonctionne mais qui prend pas mal de ligne je souhaiterais dans un but apprentissage le reduire j'ai essayer des boucle for mais sa fonctionnais pas quelqu'un aurait il une idée svp merci

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim a As Boolean, b As Boolean, c As Boolean, x As Boolean

a1 = Not Intersect(Target, Range("A4:D34")) Is Nothing
a2 = Not Intersect(Target, Range("A38:D68")) Is Nothing
a3 = Not Intersect(Target, Range("A72:D102")) Is Nothing
a4 = Not Intersect(Target, Range("A106:D136")) Is Nothing
a5 = Not Intersect(Target, Range("A140:D170")) Is Nothing
a6 = Not Intersect(Target, Range("A174:D204")) Is Nothing
a7 = Not Intersect(Target, Range("A208:D238")) Is Nothing
a8 = Not Intersect(Target, Range("A242:D272")) Is Nothing
a9 = Not Intersect(Target, Range("A276:D306")) Is Nothing
a10 = Not Intersect(Target, Range("A310:D340")) Is Nothing
a11 = Not Intersect(Target, Range("A344:D374")) Is Nothing
a12 = Not Intersect(Target, Range("A378:D408")) Is Nothing
a13 = Not Intersect(Target, Range("A412:D442")) Is Nothing
a14 = Not Intersect(Target, Range("A446:D618")) Is Nothing
a15 = Not Intersect(Target, Range("A480:D476")) Is Nothing
a16 = Not Intersect(Target, Range("A514:D510")) Is Nothing
a17 = Not Intersect(Target, Range("A548:D544")) Is Nothing
a18 = Not Intersect(Target, Range("A582:D578")) Is Nothing
a19 = Not Intersect(Target, Range("A616:D646")) Is Nothing
a20 = Not Intersect(Target, Range("A650:D680")) Is Nothing
a21 = Not Intersect(Target, Range("A684:D714")) Is Nothing
a22 = Not Intersect(Target, Range("A718:D748")) Is Nothing
a23 = Not Intersect(Target, Range("A782:D752")) Is Nothing
a24 = Not Intersect(Target, Range("A786:D816")) Is Nothing
a25 = Not Intersect(Target, Range("A820:D850")) Is Nothing
a26 = Not Intersect(Target, Range("A854:D884")) Is Nothing
a27 = Not Intersect(Target, Range("A888:D918")) Is Nothing
a28 = Not Intersect(Target, Range("A922:D952")) Is Nothing
a29 = Not Intersect(Target, Range("A956:D986")) Is Nothing
a30 = Not Intersect(Target, Range("A990:D1020")) Is Nothing
a31 = Not Intersect(Target, Range("A1024:D1054")) Is Nothing


b1 = Not Intersect(Target, Range("E4:H34")) Is Nothing
b2 = Not Intersect(Target, Range("E38:H68")) Is Nothing
b3 = Not Intersect(Target, Range("E72:H102")) Is Nothing
b4 = Not Intersect(Target, Range("E106:H136")) Is Nothing
b5 = Not Intersect(Target, Range("E140:H170")) Is Nothing
b6 = Not Intersect(Target, Range("E174:H204")) Is Nothing
b7 = Not Intersect(Target, Range("E208:H238")) Is Nothing
b8 = Not Intersect(Target, Range("E242:H272")) Is Nothing
b9 = Not Intersect(Target, Range("E276:H306")) Is Nothing
b10 = Not Intersect(Target, Range("E310:H340")) Is Nothing
b11 = Not Intersect(Target, Range("E344:H374")) Is Nothing
b12 = Not Intersect(Target, Range("E378:H408")) Is Nothing
b13 = Not Intersect(Target, Range("E412:H442")) Is Nothing
b14 = Not Intersect(Target, Range("E446:H618")) Is Nothing
b15 = Not Intersect(Target, Range("E480:H476")) Is Nothing
b16 = Not Intersect(Target, Range("E514:H510")) Is Nothing
b17 = Not Intersect(Target, Range("E548:H544")) Is Nothing
b18 = Not Intersect(Target, Range("E582:H578")) Is Nothing
b19 = Not Intersect(Target, Range("E616:H646")) Is Nothing
b20 = Not Intersect(Target, Range("E650:H680")) Is Nothing
b21 = Not Intersect(Target, Range("E684:H714")) Is Nothing
b22 = Not Intersect(Target, Range("E718:H748")) Is Nothing
b23 = Not Intersect(Target, Range("E782:H752")) Is Nothing
b24 = Not Intersect(Target, Range("E786:H816")) Is Nothing
b25 = Not Intersect(Target, Range("E820:H850")) Is Nothing
b26 = Not Intersect(Target, Range("E854:H884")) Is Nothing
b27 = Not Intersect(Target, Range("E888:H918")) Is Nothing
b28 = Not Intersect(Target, Range("E922:H952")) Is Nothing
b29 = Not Intersect(Target, Range("E956:H986")) Is Nothing
b30 = Not Intersect(Target, Range("E990:H1020")) Is Nothing
b31 = Not Intersect(Target, Range("E1024:H1054")) Is Nothing

C1 = Not Intersect(Target, Range("I4:L34")) Is Nothing
C2 = Not Intersect(Target, Range("I38:L68")) Is Nothing
C3 = Not Intersect(Target, Range("I72:L102")) Is Nothing
C4 = Not Intersect(Target, Range("I106:L136")) Is Nothing
C5 = Not Intersect(Target, Range("I140:L170")) Is Nothing
C6 = Not Intersect(Target, Range("I174:L204")) Is Nothing
C7 = Not Intersect(Target, Range("I208:L238")) Is Nothing
C8 = Not Intersect(Target, Range("I242:L272")) Is Nothing
C9 = Not Intersect(Target, Range("I276:L306")) Is Nothing
C10 = Not Intersect(Target, Range("I310:L340")) Is Nothing
C11 = Not Intersect(Target, Range("I344:L374")) Is Nothing
C12 = Not Intersect(Target, Range("I378:L408")) Is Nothing
C13 = Not Intersect(Target, Range("I412:L442")) Is Nothing
C14 = Not Intersect(Target, Range("I446:L618")) Is Nothing
C15 = Not Intersect(Target, Range("I480:L476")) Is Nothing
C16 = Not Intersect(Target, Range("I514:L510")) Is Nothing
C17 = Not Intersect(Target, Range("I548:L544")) Is Nothing
C18 = Not Intersect(Target, Range("I582:L578")) Is Nothing
C19 = Not Intersect(Target, Range("I616:L646")) Is Nothing
C20 = Not Intersect(Target, Range("I650:L680")) Is Nothing
C21 = Not Intersect(Target, Range("I684:L714")) Is Nothing
C22 = Not Intersect(Target, Range("I718:L748")) Is Nothing
C23 = Not Intersect(Target, Range("I782:L752")) Is Nothing
C24 = Not Intersect(Target, Range("I786:L816")) Is Nothing
C25 = Not Intersect(Target, Range("I820:L850")) Is Nothing
C26 = Not Intersect(Target, Range("I854:L884")) Is Nothing
C27 = Not Intersect(Target, Range("I888:L918")) Is Nothing
C28 = Not Intersect(Target, Range("I922:L952")) Is Nothing
C29 = Not Intersect(Target, Range("I956:L986")) Is Nothing
C30 = Not Intersect(Target, Range("I990:L1020")) Is Nothing
C31 = Not Intersect(Target, Range("I1024:L1054")) Is Nothing





If Target.Row >= 4 Then
On Error Resume Next



Application.Run "Macro" & (a1 * -1) + (a2 * -1) + (a3 * -1) + (a4 * -1) + (a5 * -1) + (a6 * -1) + (a7 * -1) + (a8 * -1) + (a9 * -1) + (a10 * -1) + (a11 * -1) + (a12 * -1) + (a13 * -1) + (a14 * -1) + (a15 * -1) + (a16 * -1) + (a17 * -1) + (a18 * -1) + (a19 * -1) + (a20 * -1) + (a21 * -1) + (a22 * -1) + (a23 * -1) + (a24 * -1) + (a25 * -1) + (a26 * -1) + (a27 * -1) + (a28 * -1) + (a29 * -1) + (a30 * -1) + (a31 * -1)
Application.Run "Macro" & (b1 * -2) + (b2 * -2) + (b3 * -2) + (b4 * -2) + (b5 * -2) + (b6 * -2) + (b7 * -2) + (b8 * -2) + (b9 * -2) + (b10 * -2) + (b11 * -2) + (b12 * -2) + (b13 * -2) + (b14 * -2) + (b15 * -2) + (b16 * -2) + (b17 * -2) + (b18 * -2) + (b19 * -2) + (b20 * -2) + (b21 * -2) + (b22 * -2) + (b23 * -2) + (b24 * -2) + (b25 * -2) + (b26 * -2) + (b27 * -2) + (b28 * -2) + (b29 * -2) + (b30 * -2) + (b31 * -2)
Application.Run "Macro" & (C1 * -3) + (C2 * -3) + (C3 * -3) + (C4 * -3) + (C5 * -3) + (C6 * -3) + (C7 * -3) + (C8 * -3) + (C9 * -3) + (C10 * -3) + (C11 * -3) + (C12 * -3) + (C13 * -3) + (C14 * -3) + (C15 * -3) + (C16 * -3) + (C17 * -3) + (C18 * -3) + (C19 * -3) + (C20 * -3) + (C21 * -3) + (C22 * -3) + (C23 * -3) + (C24 * -3) + (C25 * -3) + (C26 * -3) + (C27 * -3) + (C28 * -3) + (C29 * -3) + (C30 * -3) + (C31 * -3)


End If

End Sub
 
Trier par date Trier par votes
H

Hieu

XLDnaute Impliqué
Salut,

Une idée, à tester :
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mac(1 To 3)
Dim a(1 To 31) As Boolean, b(1 To 31) As Boolean, c(1 To 31) As Boolean
'Dim x As Boolean ??

For i = 1 To 31
    a(i) = Not Intersect(Target, Range("a" & 4 + k & ":d" & 34 + k)) Is Nothing
    b(i) = Not Intersect(Target, Range("e" & 4 + k & ":h" & 34 + k)) Is Nothing
    c(i) = Not Intersect(Target, Range("i" & 4 + k & ":l" & 34 + k)) Is Nothing
    k = k + 34
Next i

If Target.Row >= 4 Then On Error Resume Next

For j = 1 To 3
    For i = 1 To 31
        mac(j) = mac(j) + a(i) * (-j)
    Next i
 Application.Run "Macro" & mac(j)
Next i

End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

Jojo973
  • Question
Microsoft 365 Trouver et attribuer une plage de cellule en fonction de la cellule active
Réponses
6
Affichages
399
Jojo973
Jojo973
U
  • Question
Autres [RESOLU] Déclaration de variable
Réponses
5
Affichages
497
un internaute
U
A
  • Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
280
sylvanu
sylvanu
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Code afficher/Masquer problème
Réponses
10
Affichages
508
chaelie2015
chaelie2015
ralph45
  • Question
Microsoft 365 [VBA] Listes déroulantes à choix multiples sur N colonnes discontinues
Réponses
4
Affichages
554
ralph45
ralph45
Amigo
  • Question
XL 2016 Protéger Plage avec condition
2
Réponses
16
Affichages
902
Amigo
Amigo
chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
494
chaelie2015
chaelie2015
D
  • Question
Microsoft 365 Application.WorksheetFunction.VLookup ne fonctionne pas au delà de 8500 lignes
Réponses
4
Affichages
591
DimiJuju
D
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
598
dadu35
D
N
  • Résolu(e)
Microsoft 365 Ajouter une condition dans une VBA
Réponses
2
Affichages
382
Nathan027
N

Membres actuellement en ligne

2 membres et 40 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
315 087
Messages
2 116 082
Membres
112 654
dernier inscrit
SADIKA