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

vanounouille

XLDnaute Nouveau
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
 

Pièces jointes

  • Calendrier scolaire (universel)1.xlsx
    140.8 KB · Affichages: 34

job75

XLDnaute Barbatruc
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) :
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.
 

Pièces jointes

  • Calendrier scolaire (universel)(1).xlsm
    156.5 KB · Affichages: 31
Dernière édition:

job75

XLDnaute Barbatruc
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+
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla