XL 2016 Rechercher une date et reporter une cellule correspondante dans un calendrier

[vanounouille]

Bonjour à tous !
Alors mon problème : dans la feuille 1 j'ai une liste de date à laquelle j'ai eu un cours (cellule que je dois remplir). Les colonnes d'après se remplissent automatiquement en indiquant J+2, J+4 ...
J'aurais voulu qu'à chaque fois que une date apparait le numéro de cours correspondant soit reporté dans la feuille calendrier.
Exemple de la ligne 2 : j'ai rempli 6 septembre 2018 et automatiquement il m'a mit 8 septembre, 10 septembre etc. Cela correspond au cours numéro 1. J'aimerais que dans la feuille 2 se reporte le numéro 1 dans les cases correspondantes.
Mais du coup si sur la ligne par exemple 10 réapparait une date il faudrait que dans la case du calendrier il y est marqué 1 + 9 (et du coup ce jour là je devrais réviser le cours 1 et le cours 9).

Je ne sais pas si j'ai été bien clair...
Je vous joins mon fichier

Merci de votre aide

Vanounouille

 

[job75]

Bonjour vanounouille, bienvenue sur XLD, le forum,

Problème intéressant, bravo pour ce 1er message.

La macro dans la feuille "Calendrier" du fichier joint (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim d As Object, r As Range, x$, i%, c As Range
Application.ScreenUpdating = False
'---adresses des cellules et effacement des cours---
Set d = CreateObject("Scripting.Dictionary")
For Each r In UsedRange
    If r.Formula Like "=Jours*" Then
        d(r.Value) = r(2).Address 'mémorisation de l'adresse
        If Val(r(2)) > 0 Then
            x = Application.Trim(r(2).Value) 'SUPPRESPACE
            For i = 1 To Len(x) + 1
                If Not IsNumeric(Mid(x, i, 1)) And Mid(x, i, 1) <> "+" Then _
                    r(2) = Mid(x, i): Exit For
            Next i
        End If
    End If
Next r
'---entrée des cours---
For Each r In Feuil1.UsedRange.Offset(1, 1)
    If d.exists(r.Value) Then
        Set c = Range(d(r.Value))
        x = Application.Trim(c.Value) 'SUPPRESPACE
        For i = 1 To Len(x) + 1
            If Not IsNumeric(Mid(x, i, 1)) And Mid(x, i, 1) <> "+" Then _
                c = Left(x, i - 1) & r(1, 2 - r.Column) & "+" & Mid(x, i): Exit For
        Next i
    End If
Next r
End Sub

Elle s'exécute quand on active la feuille.

L'objet Dictionary permet de réduire la durée des recherches.

Bonne journée.

 

[job75]

Re,

J'ai testé avec 365 lignes de dates dans la 1ère feuille : la macro s'exécute chez moi en 5 secondes.

A+

 

[vanounouille]

Merci tu es génial

 

[job75]

Re,

Je viens de corriger un phénomène curieux au post #2.

Avec x = Application.Trim(r(2)) et x = Application.Trim(c) la macro beugue au delà de 256 caractères.

Plus de problème avec x = Application.Trim(r(2).Value) et x = Application.Trim(c.Value)

Vous saviez ça ???

A+

 

[job75]

Re,

Du coup j'ai entré la date du 06/09/2018 en Feuil1 sur toute la plage B2:B1000.

La macro s'exécute en 29 secondes et la cellule Calendrier!E6 (vide au départ) contient 3888 caractères.

A+