XL 2010 Optimiser une macro permettant de lancer des macro

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
 

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
 

Discussions similaires

  • Résolu(e)
XL 2021 macro
Réponses
9
Affichages
428

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 841
dernier inscrit
ferid87