Optimisation code avec boucle et gestion d'erreurs

Bonjour le forum

Comme indiqué dans le titre je dispose d'un code (qui n'est pas très jojo). Je pense qu'il est possible d'optimiser tout ça avec une boucle du style For i = x to y mais là je suis complètement perdus

Voilà le code :

Private Sub Affichage()

Date1 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 5
Date2 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 4
Date3 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 3
Date4 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 2
Date5 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 1
Date6 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3))
Date7 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) + 1

Me.J1.Caption = Format(Date1, "dddd dd/mm")
Me.J2.Caption = Format(Date2, "dddd dd/mm")
Me.J3.Caption = Format(Date3, "dddd dd/mm")
Me.J4.Caption = Format(Date4, "dddd dd/mm")
Me.J5.Caption = Format(Date5, "dddd dd/mm")
Me.J6.Caption = Format(Date6, "dddd dd/mm")
Me.J7.Caption = Format(Date7, "dddd dd/mm")

With Feuil1
    Me.J1H1.Caption = Format(WorksheetFunction.VLookup(CDbl(Date1), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 2, False), "hh:mm")
    Me.J1H2.Caption = Format(WorksheetFunction.VLookup(CDbl(Date1), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 3, False), "hh:mm")
    Me.J1H3.Caption = Format(WorksheetFunction.VLookup(CDbl(Date1), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 4, False), "hh:mm")
    Me.J1H4.Caption = Format(WorksheetFunction.VLookup(CDbl(Date1), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 5, False), "hh:mm")

    Me.J2H1.Caption = Format(WorksheetFunction.VLookup(CDbl(Date2), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 2, False), "hh:mm")
    Me.J2H2.Caption = Format(WorksheetFunction.VLookup(CDbl(Date2), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 3, False), "hh:mm")
    Me.J2H3.Caption = Format(WorksheetFunction.VLookup(CDbl(Date2), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 4, False), "hh:mm")
    Me.J2H4.Caption = Format(WorksheetFunction.VLookup(CDbl(Date2), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 5, False), "hh:mm")

    Me.J3H1.Caption = Format(WorksheetFunction.VLookup(CDbl(Date3), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 2, False), "hh:mm")
    Me.J3H2.Caption = Format(WorksheetFunction.VLookup(CDbl(Date3), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 3, False), "hh:mm")
    Me.J3H3.Caption = Format(WorksheetFunction.VLookup(CDbl(Date3), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 4, False), "hh:mm")
    Me.J3H4.Caption = Format(WorksheetFunction.VLookup(CDbl(Date3), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 5, False), "hh:mm")

    Me.J4H1.Caption = Format(WorksheetFunction.VLookup(CDbl(Date4), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 2, False), "hh:mm")
    Me.J4H2.Caption = Format(WorksheetFunction.VLookup(CDbl(Date4), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 3, False), "hh:mm")
    Me.J4H3.Caption = Format(WorksheetFunction.VLookup(CDbl(Date4), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 4, False), "hh:mm")
    Me.J4H4.Caption = Format(WorksheetFunction.VLookup(CDbl(Date4), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 5, False), "hh:mm")

    Me.J5H1.Caption = Format(WorksheetFunction.VLookup(CDbl(Date5), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 2, False), "hh:mm")
    Me.J5H2.Caption = Format(WorksheetFunction.VLookup(CDbl(Date5), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 3, False), "hh:mm")
    Me.J5H3.Caption = Format(WorksheetFunction.VLookup(CDbl(Date5), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 4, False), "hh:mm")
    Me.J5H4.Caption = Format(WorksheetFunction.VLookup(CDbl(Date5), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 5, False), "hh:mm")

    Me.J6H1.Caption = Format(WorksheetFunction.VLookup(CDbl(Date6), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 2, False), "hh:mm")
    Me.J6H2.Caption = Format(WorksheetFunction.VLookup(CDbl(Date6), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 3, False), "hh:mm")
    Me.J6H3.Caption = Format(WorksheetFunction.VLookup(CDbl(Date6), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 4, False), "hh:mm")
    Me.J6H4.Caption = Format(WorksheetFunction.VLookup(CDbl(Date6), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 5, False), "hh:mm")

    Me.J7H1.Caption = Format(WorksheetFunction.VLookup(CDbl(Date7), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 2, False), "hh:mm")
    Me.J7H2.Caption = Format(WorksheetFunction.VLookup(CDbl(Date7), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 3, False), "hh:mm")
    Me.J7H3.Caption = Format(WorksheetFunction.VLookup(CDbl(Date7), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 4, False), "hh:mm")
    Me.J7H4.Caption = Format(WorksheetFunction.VLookup(CDbl(Date7), .Range("A2:E" & .Range("A65000").End(xlUp).Row), 5, False), "hh:mm")
End With

End Sub

Par avance merci de l’intérêt porté au sujet

Bonjour,

En effet c'est largement possible d'optimiser ta macro

Private Sub Affichage()

Date1 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 5

For i = -5 To 1
    Controls("J" & i + 6).Caption = Format(Date1 + i, "dddd dd/mm")

    For j = 1 To 4
        Controls("J" & i + 6 & "H" & j).Caption = Format(Feuil1.Cells(2 + i + 5, j + 1), "hh:mm")
    Next j
Next i
End Sub

Oui c'est tout

Me n'est pas nécessaire comme tu codes déjà dans le formulaire, et j'utilise Controls(nomducontrole as String) pour pouvoir appeler un contrôle via son nom ainsi tu peux gérer tout ça juste avec ces quelques lignes

Oh j'ai aussi enlevé toutes tes recherches de valeur, on peut facilement s'en sortir avec cells(ligne,colonne) et les variables qu'on à utilisé

Bonjour, merci de retour

Le code fonctionne bien mais le soucis est que quand je vais rajouter des dates dans la liste et que je vais naviguer dans ces dates, les heures saisies correspondantes ne vont pas se mettre à jour... C'est pourquoi j'était partir sur du RechercheV pour remplir les Label. Ou y a t-il une autre solution ?

Ok en modifiant un peux ton code j'obtient bien ce que je veux, il me reste cependant un détail à régler

Pour commencer voilà le code modifié :

Private Sub Affichage()
Date1 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 6

For i = 1 To 7
    Controls("J" & i).Caption = Format(Date1 + i, "dddd dd/mm")

    For j = 1 To 4
        Controls("J" & i & "H" & j).Caption = _
        Format(WorksheetFunction.VLookup(CDbl(Date1 + i), Feuil1.Range("A2:E" & Feuil1.Range("A65000").End(xlUp).Row), j + 1, False), "hh:mm")
    Next j
Next i

End Sub

Pour finaliser tout ça il faudrais que quand aucunes valeurs n'est trouvée par recherchev il laisse les Label vide. J'avais penser à On error resume next mais ça ne reset pas les label ...

Finalement je trouve tout seul ! (enfin merci Microsoft doc )

Voilà le code :

Private Sub Affichage()
Date1 = 7 * NoSem + DateSerial(Annee, 1, 3) - WorksheetFunction.Weekday(DateSerial(Annee, 1, 3)) - 6

For i = 1 To 7
    Controls("J" & i).Caption = Format(Date1 + i, "dddd dd/mm")

    For j = 1 To 4

        Code = Application.VLookup(CDbl(Date1 + i), Feuil1.Range("A2:E" & Feuil1.Range("A65000").End(xlUp).Row), j + 1, False)

        If Not IsError(Code) Then
            Controls("J" & i & "H" & j).Caption = Format(Code, "hh:mm")
        Else
            Controls("J" & i & "H" & j).Caption = ""
        End If

    Next j

Next i

End Sub

Re

Sinon si tu en as marre de passer par des WorksheetFunction et Range("a1","a65000"), tu peux utiliser :

ligFin = Range("a" & Rows.Count).End(xlUp).Row

pour avoir la dernière ligne en prenant en référence la colonne A, Rows.Count permet de renvoyer le nombre de ligne que contient ta feuille active, pas besoin de s'embêter avec 6 * * * *.

Range("a1","a" & ligFin).Find(valeur,LookAt:=xlWhole).Row

pour avoir la ligne où se trouve la valeur que tu cherches, renvoie une erreur si aucune valeur trouvée (donc compatible avec on Error goto)

C'est toi qui vois