4 For ...Next imbriqués : code à optimiser

[cibleo]

Bonsoir le forum

Dans la partie haute de mon tableau (la partie colorée), figurent dans chaque colonne 7 prénoms ordonnés différemment.

Dans la partie basse à partir de la ligne 27, j'ai placé sous chaque colonne une liste de personnes pouvant être absentes.

J'ai donc réalisé une macro qui me permet d'estampiller les absents à l'aide d'une shape dans cette partie haute.

Mais j'ai l'impression d'avoir monté une usine à gaz en imbriquant 4 boucles for ...next.
Peut-on optimiser le code ci-dessous, je pense que l'on peut retirer la boucle :

For p = LBound(rng) To UBound(rng)

Sub Cibler_les_Absents1()
Dim c1 As Range, LaDate As Long, idx As Variant, feuille As Worksheet
Dim Absence As String, c As Range, n As Byte, m As Byte, p As Byte, i As Byte, trouve As Boolean
Application.ScreenUpdating = False
Set feuille = Sheets("Feuil1")
For Each c1 In Range("B4:AB4")
  If c1 <> "" Then
    LaDate = CLng([c1])
    idx = Application.Match(LaDate, Range("B4:AB4"), 0)
    rng = Array("Claudine", "Guillaume", "Sandra", "Valérie", "Jean-Luc", "Stéphanie", "Bruno")
    Set c = feuille.Range("B4:AB4").Cells(idx, idx)
    If Not c Is Nothing Then
      For n = 27 To feuille.Cells(34, c.Column).End(xlUp).Row
        trouve = False: Absence = ""
        If feuille.Cells(n, c.Column) <> "" Then
          For p = LBound(rng) To UBound(rng)
            If feuille.Cells(n, c.Column) = rng(p) Then
              Absence = rng(p)
              For m = 5 To feuille.Cells(19, c.Column).End(xlUp).Row
                If feuille.Cells(m, c.Column) = Absence Then
                  trouve = True
                  
                 'Mise en forme et placement de la Shape "Absent"
                  .../...                 
                 ' Fin de la création de la Shape "Absent"
                 
                End If
                If trouve = True Then Exit For
              Next m
            End If
            If trouve = True Then Exit For
          Next p
        End If
      Next n
    End If
  End If
Next
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Pouvez-vous m'aider ?
Le code est dans le module 1.

Bonne soirée Cibleo

 

[phlaurent55]

Re : 4 For ...Next imbriqués : code à optimiser

Bonjour cibleo,

ton fichier en retour (sans macro) avec mise en forme conditionnelle

à+
Philippe

 

[cibleo]

Bonsoir le forum,
Bonsoir Florent et merci

Oui effectivement, on peut contourner le problème par une MFC, c'est l'occasion pour moi de me replonger dans les formules

Mais bon je cherchais simplement à savoir si on pouvait optimiser le code que je vous ai fourni.

Amicalement Cibleo

 

[cibleo]

Bonjour le forum,

Pour mémoire, la macro doit estampiller les absents à l'aide d'une shape (Nuage).

Voilà, j'ai supprimé la variable tableau array.

rng = Array("Claudine", "Guillaume", "Sandra", "Valérie", "Jean-Luc", "Stéphanie", "Bruno")

et suis passé par 1 tableau dynamique ; Variable rng
Problème, ce tableau peut contenir de 0 à 7 éléments et cela buggait lorsque le tableau contenait 0 ou 1 élément. (Incompatiblité de type)

Bug sur rng et la boucle :

For p = LBound(rng, 1) To UBound(rng, 1)

Pour contourner le problème, je suis passé par un Select Case (3 cas)
- 0 élément (Pas d'absent)
- 1 élément (1 absent)
- + de 1 élément (plusieurs absents)
Voir le code dans le module 2

S'il y a mieux à faire que cette solution tarabiscotée, je suis preneur
Je pense vraiment m'être compliqué l'existence.

Pour rappel, la liste des absents pour chaque colonne, se situe à partir de la ligne 27.

Cibleo
Ps : pour l'instant, j'opte pour le premier code proposé en début de fil.

 

[pierrejean]

Re : 4 For ...Next imbriqués : code à optimiser

Bonjour cibleo

Vois si ceci te convient

 

[cibleo]

Bonjour à tous,
Bonjour PierreJean

C'est ce qu'on appelle une cure d'amaigrissement
Quand je vois la limpidité de ton code comparé à ce que j'avais proposé, certains doivent vraiment se marrer

Sinon, j'ai ordonné ces instructions dans cet ordre, ça buggait.

.../...
    If InStr(Garcons, cel.Value) <> 0 Then
      .Fill.ForeColor.SchemeColor = 41
      .TextFrame.Characters.Text = cel.Value & vbLf & "est absent"
    Else
      .TextFrame.Characters.Text = cel.Value & vbLf & "est absente"
    End If
    .TextFrame.Characters.Font.Size = 8
    .TextFrame.Characters.Font.Name = "Verdana"
    .TextFrame.HorizontalAlignment = xlHAlignCenter
    .TextFrame.VerticalAlignment = xlVAlignCenter
End With
.../...

Au plaisir et merci PierreJean
Cibleo