Macro : recherche de valeurs dans différents onglets/affichage cellules

Salut calvinethobbes,

Bienvenue !

Petite remise en forme après de nombreux mois d'interruption...

Je ne sais pas si je prends le problème dans le bon sens : ici, tout changement dans les feuilles nominatives se répercute dans 'CALENDRIER' ; tu aurais peut-être voulu un affichage APRÈS le choix d'une date en 'CALENDRIER' ??

Souci : à première vue, l'année n'est pas communiquée dans les feuilles nominatives ! Aussi, par défaut, j'ai pris l'année en cours pour le calcul ! Á préciser !

Á tester ! Donc, il faut d'abord un changement dans les feuilles nominatives pour voir un résultat en 'CALENDRIER'.

A+

Bonjour,

Sub Remplissage_Auto()
Dim Ws As Worksheet
Dim DernièreLigne As Integer
Dim DernièreColonne As Integer
Dim LettreDernièreColonne As String
Dim TailleTableau As Integer
Dim RangeFeuille As range
Dim Cell
Dim OffsetAAM As Integer
Dim LeJour As Integer
Dim LeMois As Integer

Dim Feuille() As Variant
ReDim Feuille(ThisWorkbook.Sheets.Count, 2)

i = 1
TailleTableau = 1
For Each Ws In ThisWorkbook.Sheets
    If Not Ws.Name = "CALENDRIER" Then
        Feuille(i, 1) = Ws.Name
        DernièreLigne = Ws.range("A65535").End(xlUp).Row
        DernièreColonne = Ws.Cells(2, Columns.Count).End(xlToLeft).Column
        If DernièreColonne > 26 Then
            LettreDernièreColonne = "A"
            DernièreColonne = DernièreColonne - 26
        Else
            LettreDernièreColonne = ""
        End If
        LettreDernièreColonne = LettreDernièreColonne & Chr(DernièreColonne + 64)
        Feuille(i, 2) = "H5:" & LettreDernièreColonne & DernièreLigne
        i = i + 1
        TailleTableau = TailleTableau + 1
    End If
Next

For i = 1 To TailleTableau - 1
    Set RangeFeuille = Sheets(Feuille(i, 1)).range(Feuille(i, 2))
    For Each Cell In RangeFeuille
        If Cell.Value = "" Then GoTo Suivante
        OffsetAAM = 0
        If Right(Cell.Value, 2) = "AM" Then
            OffsetAAM = 2
        ElseIf Right(Cell.Value, 1) = "M" Then
            OffsetAAM = 1
        End If
        LeJour = Left(Cell.Value, 2)
        LeMois = Right(Left(Cell.Value, 5), 2)
        For j = 1 To 13 Step 3
            If Month(Sheets("CALENDRIER").Cells(2, j)) = LeMois Then
                For k = 4 To 34
                    If Day(Sheets("CALENDRIER").Cells(k, j)) = LeJour Then
                        'MsgBox Cell.Value & " " & Feuille(i, 1) & Cell.Address
                        If Sheets("CALENDRIER").Cells(k, j).Offset(0, OffsetAAM) = "" Then
                            Sheets("CALENDRIER").Cells(k, j).Offset(0, OffsetAAM) = Sheets(Feuille(i, 1)).Cells(Cell.Row, "A")
                        Else
                            Sheets("CALENDRIER").Cells(k, j).Offset(0, OffsetAAM) = Sheets("CALENDRIER").Cells(k, j).Offset(0, OffsetAAM) & " / " & Sheets(Feuille(i, 1)).Cells(Cell.Row, "A")
                        End If
                    End If
                Next
            End If
        Next
Suivante:
    Next
Next

End Sub

J'envoie le mien quand même au cas où

Bonne journée

Merci pour vos réponses !

Alors :

@curulis57 :

L'ordre est le suivant : on rentre une date dans les onglets "Neruda C1" ou "Vilar C2" etc. Ensuite le nom de la personne doit s'afficher dans "Calendrier" en fonction des dates rentrées. Pour l'année c'est de septembre 2020 à juin 2021 (tu peux le voir dans l'onglet calendrier, cela affiche mardi 1er mais dans la cellule c'est sous la forme 01/09/2020).

Edit : @curulis57 :

Alors effectivement je viens de me rendre compte que cela fonctionne parfaitement.

Par contre il faut que je re rentre manuellement toutes les dates dans les onglets pour que cela se mette à jour ??!?

Il n'est pas possible que cela s'actualise automatiquement en fonction de tout ce qui est déjà rentré ? Parce que je me suis déjà tout tapé à rentrer à la main, je vais devenir maboul

Edit : Bon ça marche nickel ! J'ai juste besoin de rentrer une fois la date dans un des onglets....ça va le faire !

Merci beaucoup beaucoup beaucoup !!! Enormément

Dernière petite modification : j'ai ajouté le reste de l'année (jusqu'en juin).

Serait-il possible de modifier la macro pour y inclure les cellules restantes dans "Calendrier" svp ? Car cela ne marche plus pour ces cellules qui sont éloignées...

J'ai peur de ne pas pouvoir la bidouiller correctement...

Tu parles de ma macro ?

Ah non Moul...mince c'est vrai que je n'ai pas testé la tienne...j'essaie de ce pas !

Pour que la mienne fonctionne jusqu'à Juin tu dois modifier la ligne

For j = 1 To 13 Step 3

Par

For j = 1 To 28 Step 3

Et normalement ça tourne

Mais si tu dois faire le programme plusieurs fois il faudrait peut être d'abord faire une macro pour vider ta feuille

Salut Calvin,
Salut Moul,

je regarde et peaufine tout ça ce soir!

A+

Salut Calvin,

Salut Moul,

voici ton fichier ! Comme d'hab', je suppose que j'en ai encore trop fait! Á toi de me dire...

- Pour les besoins de la cause, j'ai ajouté en 'CALENDRIER' [A3] l'année du début de l'année scolaire.

- Deux modes de calcul:

• global : un double-clic gauche en 'CALENDRIER' [A3] recalcule l'entièreté de ton tableau en 'CALENDRIER' ;
• à l'encodage : chaque changement dans une feuille nominative recalcule la date encodée, que ce soit un encodage sur un emplacement vide ou une correction.

- Deux manières de sélectionner une cellule-cible dans un liste nominative:

• clic gauche : l'affichage reste sur la même feuille après le calcul ;
• clic droit : 'CALENDRIER' s'affiche en se calant sur le mois de la date encodée.

- La validité d'une date encodée dans une liste nominative est contrôlée avant d'être calculée. En cas d'erreur, un message t'avertit et efface la cellule.
Là, je n'ai pas poussé les tests à l'extrême, me disant que tu n'encoderas pas des bêtises pour le plaisir...

- Pour te faciliter la préparation d'un nouveau fichier, j'ai automatisé la datation de tes colonnes en 'CALENDRIER'.

• D'ABORD enregistrer le fichier en cours sous un nouveau nom correspondant à la nouvelle année scolaire ;
• Ensuite, modifier l'année en 'CALENDRIER' [A3] : toutes les données et couleurs intérieures s'effacent, les dates s'actualisent, les mercredis, samedis et dimanches s'ornent d'un PATTERN.
  N'ayant pas compris les formules MFC des couleurs INTERIOR de 'CALENDRIER', je n'y ai pas touché : si tu veux un traitement par code, faudra expliquer!

- Enfin, dans 'CALENDRIER', pour compléter les PATTERN dans d'autres jours, tu as deux possibilités.

• sélectionner PLUSIEURS cellules du bouton gauche agrémentera les cellules sélectionnées (en évitant bien évidemment les colonnes-dates!) d'un PATTERN ou le supprimera si existant ;
• tu peux faire de même d'un clic-droit avec effet identique cellule par cellule.

Les codes se répartissent dans les modules VBA de 'CALENDRIER', 'ThisWorkbook' et le Module1.

Public Sub Scanner(ByVal iMode%, sData$, iType%, rCel As Range)
'
Dim sWk As Worksheet, tCal, tTab
Dim iDay%, iMonth%, iCol%, iOK%, sDate$, sMsg$
'
Set sWk = Worksheets("CALENDRIER")
tCal = sWk.Range("A3:AD35").Value
sWk.Range("A4:AD35").HorizontalAlignment = xlHAlignLeft
'
For k = 1 To IIf(iMode = 1, IIf(sWk.[A3] Mod 4 = 0, 366, 365), 1)
    For x = 1 To 2
        sMsg = ""
        If iMode = 1 Then
            If x = 1 Then dDate = DateAdd("d", k, "31/08/" & CStr(sWk.[A3]))
            sDate = CStr(Format(Day(dDate), "00")) & "/" & CStr(Format(Month(dDate), "00")) & IIf(x = 1, " M", " AM")
        Else
            sDate = IIf(x = 1, CStr(sWk.[AAA1]), sData)
        End If
        If sDate <> "" Then
            If fctCheck(sDate) = 1 Then
                iDay = CInt(Left(sDate, 2))
                iMonth = CInt(Mid(sDate, 4, 2)) + IIf(CInt(Mid(sDate, 4, 2)) > 8, -9, 3)
                tCal(1 + iDay, 1 + (iMonth * 3) + CInt(Len(Split(sDate, " ")(1)))) = ""
                For y = 2 To Sheets.Count
                    tTab = Sheets(y).Range("A5:AD35").Value
                    For Z = 8 To UBound(tTab, 2)
                        For w = 1 To UBound(tTab, 1)
                            If tTab(w, Z) = sDate Then sMsg = sMsg & IIf(sMsg = "", "", ", ") & tTab(w, 1)
                        Next
                    Next
                Next
                tCal(1 + iDay, 1 + (iMonth * 3) + CInt(Len(Split(sDate, " ")(1)))) = sMsg
            Else
                iOK = 1
                If iMode = 2 And x = 2 Then rCel.Value = ""
                MsgBox "La date doit être comprise entre Septembre " & sWk.[A3] & " et Juin " & sWk.[A3] + 1 & " !", vbInformation + vbOKOnly, "Encodage horaires - Info"
            End If
        End If
    Next
    If iMode = 1 Then _
        If Month(DateAdd("d", 1, dDate)) = 7 Then Exit For
Next
sWk.[AAA1] = ""
sWk.[AAA2] = ""
sWk.Range("A3:AD35").Value = tCal
If iOK = 0 Then
    If iMode = 1 Then sWk.[A1].Select
    If iMode = 2 And iType = 0 Then
        Worksheets("CALENDRIER").Activate
        ActiveWindow.ScrollColumn = 1 + (iMonth * 3)
    End If
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Á tester!

A+