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