Optimisation code VBA lent

Salut,

J'ai besoin de quelqu'un qui peut m'aider à optimiser ce code qui est trop lent...

 Dim mat As Range
 Dim types As Range
 Set mat = Range("AE2041:AE100000")
 Set types = Range("AF2041:AF100000")
 Dim mat_ag, mat_ah, mat_ai, mat_aj, mat_ak, mat_al As Range
 Dim typ_ag, typ_ah, typ_ai, typ_aj, typ_ak, typ_al As Range

 Set mat_ag = Target.Offset(0, 2)
 Set mat_ah = Target.Offset(0, 3)
 Set mat_ai = Target.Offset(0, 4)
 Set mat_aj = Target.Offset(0, 5)
 Set mat_ak = Target.Offset(0, 6)
 Set mat_al = Target.Offset(0, 7)
 Set typ_ag = Target.Offset(0, 1)
 Set typ_ah = Target.Offset(0, 2)
 Set typ_ai = Target.Offset(0, 3)
 Set typ_aj = Target.Offset(0, 4)
 Set typ_ak = Target.Offset(0, 5)
 Set typ_al = Target.Offset(0, 6)

 If Not Application.Intersect(Target, mat) Is Nothing Then ' MsgBox (Target.Address & "  " & ag & "  " & Target.Column)
    mat_ag.ClearContents
    mat_ah.ClearContents
    mat_ai.ClearContents
    mat_aj.ClearContents
    mat_ak.ClearContents
    mat_al.ClearContents
 End If
 If Not Application.Intersect(Target, types) Is Nothing Then
    typ_ag.ClearContents
    typ_ah.ClearContents
    typ_ai.ClearContents
    typ_aj.ClearContents
    typ_ak.ClearContents
    typ_al.ClearContents
 End If

J'aimerais que le code -> efface (.ClearContents) de Target.Offset(0, 2) à Target.Offset(0, 7) en une seul fois.

J'ai fouillé un peu partout mais je n'ai pas trouvé.

Si quelqu'un peut m'aider svp.

Merci.

Bonsoir,

une des solutions serait d'utiliser Resize : Vous ciblez la première cellule, puis vous "redimensionnez" la plage d'une cellule (celle ciblée au départ) en une plage de cellule en augmentant le nombre de colonne et/ou de ligne :

Target.Offset(,2).Resize(1,7).ClearContents

Target cellule ciblée, Offset(,2) : on décale cette cellule de deux colonne vers la droite et 0 ligne vers la bas, Resize(1,7) : on redimensionne cette cellule avec une plage qui fait 7 colonne de large et 1 ligne de haut, ClearContents : on efface les données de cette plage ainsi définie.

@ bientôt

LouReeD

Bonsoir,

peut-être

Range(Target.Offset(0, 2), Target.Offset(0, 7)).clearcontents

Edit : la solution de Loureed, que je salue au passage, semble plus évolutive

Je n'avais pas vu :

Dim mat_ag, mat_ah, mat_ai, mat_aj, mat_ak, mat_al As Range

Attention ! Seul mat_al sera un Range, les autres seront des Variants, sous VBA le typage des variables doit être individualisé...

@ bientôt

LouReeD

Pour vos Range multiple et quasi identiques vous pouvez passer par des tableaux Range je crois :

   Dim mat As Range
   Dim types As Range
   Set mat = Range("AE2041:AE100000")
   Set types = Range("AF2041:AF100000")
    Dim TabRangeMat(1 To 6) As Range, TabRangeTyp(1 To 6) As Range, I
    For I = 1 To 6
        Set TabRangeMat(I) = Target.Offset(, I + 1)
        Set TabRangeTyp(I) = Target.Offset(, I)
    Next I
    If Not Application.Intersect(Target, mat) Is Nothing Then
        For I = 1 To 6
            TabRangeMat(I).ClearContents
        Next I
    End If
    If Not Application.Intersect(Target, types) Is Nothing Then
       For I = 1 To 6
           TabRangeTyp(I).ClearContents
       Next I
    End If

C'est à voir si cela simplifie la chose ou pas...

@ bientôt

LouReeD

Bonjour…

Pour éviter tout ennui j'utiliserai l'événement DoubleClick ainsi :

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
    Application.EnableEvents = 0
    If Not Intersect(R, [AE2041:AE100000]) Is Nothing Then R.Resize(, 7) = ""
    If Not Intersect(R, [AF2041:AF100000]) Is Nothing Then R.Resize(, 6) = ""
    Application.EnableEvents = 1
End Sub

Remarque : les 2 lignes autorisant ou bloquant les évènements peuvent être supprimées si les évènements SelectionChange (prioritaire sur DoubleClick) ou "Change" sont aussi sollicités dans les mêmes plages.

Salut à tous,

J'ai finalement opté pour

Dim mat As Range
 Dim types As Range
 Set mat = Range("AE2041:AE100000")
 Set types = Range("AF2041:AF100000")
 Dim mat_ag As Range
 Dim typ_ag As Range

 Set mat_ag = Target.Offset(, 2).Resize(1, 7) 'Target cellule ciblée, Offset(,2) : on décale cette cellule de deux colonne vers la droite et 0 ligne vers la bas, Resize(1,7) : on redimensionne cette cellule avec une plage qui fait 7 colonne de large et 1 ligne de haut
 Set typ_ag = Target.Offset(, 1).Resize(1, 7)

 If Not Application.Intersect(Target, mat) Is Nothing Then ' MsgBox (Target.Address & "  " & ag & "  " & Target.Column)
    mat_ag.ClearContents
 End If
 If Not Application.Intersect(Target, types) Is Nothing Then
    typ_ag.ClearContents
 End If

Le code est évidement bcp plus rapide.

Merci pour vos réponses très utiles!