Processus trop long avec Private Sub Worksheet_Change (ByVal Target As Range)

[Anthony_4848]

Bonjour,

J’ai un code Private Sub Worksheet_Change(ByVal Target As Range) sur vba qui est trop long, mais qui fonctionne lorsque je prends une partie du code seulement, excel dit que le processus est trop long (voici le début), il y a 3 section de 6 sous-section comportant 6 fois la répetition :

If Target.Address = "$B$11" Then
    If Target.Value <> "" Then
        Sheets("Calcul des coûts directs").Rows("9:15").EntireRow.Hidden = False
    Else
        Sheets("Calcul des coûts directs").Rows("9:15").EntireRow.Hidden = True
    End If
End If
  
If Not Application.Intersect(Target, Me.Range("$B$11,$G$11")) Is Nothing Then

    ThisWorkbook.Worksheets("Annexe").Rows(11).Hidden = _
      Len(Me.Range("$B$11").Value) = 0 Or Me.Range("$G$11").Value <> "Oui"
      
End If

Après chaque sous-section, on saute une case pour le Target.Adress (ex. la première case de la sous-section 1.2 est $B$18 et non $B$17) et on saute deux cases pour les rangés (ex. les premières cases pour la sous-section 1.2 est 53:59 au lieu de 51:57). Après chaque section on saute deux cases supplémentaires pour le Target.Adress (ex. la première case de la sous-section 2.1 est $B$55 et non $B$52) et trois cases pour les rangées (ex. les premières cases de la sous-section 2.1 est 275:281 au lieu de 264:270). J’aimerais savoir si il y avait une possibilité d’incorporer une fonction loop ou quelque chose pour alléger le code.

[Cow18]

oui, il y a des possibilités, avez-vous un fichier pour essayer ?

[Anthony_4848]

En fait, j’ai trouvé un code qui fonctionne et qu’on répète moins souvent :

Const ROWS_PER_BLOCK As Long = 7
Dim rwNum As Long, wb As Workbook

Set wb = ThisWorkbook

If Not Application.Intersect(Target, Me.Range("B11:B16")) Is Nothing Then
    rwNum = 9 + ((Target.Row - 11) * ROWS_PER_BLOCK) 'start row of block to hide/show
    wb.Sheets("Calcul des coûts directs").Cells(rwNum, "B"). _
         Resize(ROWS_PER_BLOCK).EntireRow.Hidden = (Len(Target.Value) = 0)
End If

If Not Application.Intersect(Target, Me.Range("B11:B16", "G11:G16")) Is Nothing Then
    With Target.EntireRow
        wb.Worksheets("Annexe").Rows(Target.Row).Hidden = _
            Len(.Columns("B").Value) = 0 Or .Columns("G").Value <> "Oui"
    End With
End If