Rechercher une date dans calendrier

Le 28/02/2020 à 12:35

Bonjour à tous!

Je souhaite créer un code qui me permettrait de colorer la case d'un calendrier après avoir rentré la date souhaitée dans une colonne spécifique.

Le code que j'ai écrit est le suivant :

Sub Calendrier()

Dim x As Variant, y As Variant, Cell As Range

Sheets("TEST").Select

For Each Cell In Range("AT3:AT3")

If Cell <> Empty Then

x = Cell

End If

Set y = Range("AU2:KD2").Find(x, , xlValues, xlWhole, xlByColumns, , False)

MsgBox y.Adress

Next Cell

End Sub

Pour le moment, impossible de trouver ma valeur y (donc la date recherchée) dans mon calendrier. J'ai essayé une multitude de possibilité et rien de fonctionne...

Je vous joint le fichier Excel pour que vous puissiez y voir plus clair

Merci beaucoup d'avance pour votre aide !

16test-suivi-de-prod-copie.xlsm (101.24 Ko)
Le 28/02/2020 à 13:24

Bonjour, et bienveue

ton code n'est pas le même que celui posté !

que veux-tu dire avec

If Cell = x Then Cell = Selection.Cell

je pense qu'il faut définir celA et celB (plutôt que cel1 car le 1 chiffre se confond avec le l lettre)

indente correctement ton code, il y a aussi un End If en trop car l'instruction est sur la même ligne que le then

Le 28/02/2020 à 13:51

Bonjour,

à tester,

Sub Calendrier2()
Dim x As Double, y As Variant, Cell As Range
Sheets("TEST").Select
For Each Cell In Range("AT3:AT3")
    If Cell <> Empty Then
    x = Cell
    End If
    y = Application.Match(x, Range("AU2:KD2"), 0)
    MsgBox Cells(2, Range("AT2").Column + y).Address
Next Cell
End Sub
Le 28/02/2020 à 13:56
Steelson a écrit :

Bonjour, et bienveue

ton code n'est pas le même que celui posté !

que veux-tu dire avec

If Cell = x Then Cell = Selection.Cell

je pense qu'il faut définir celA et celB (plutôt que cel1 car le 1 chiffre se confond avec le l lettre)

indente correctement ton code, il y a aussi un End If en trop car l'instruction est sur la même ligne que le then

Bonjour, merci pour la réponse rapide ! J'ai dû faire une erreur en créant la copie, mais le code que j'essaye d'utiliser et bien celui de mon premier message

Cela devrait être bon dans ce fichier :

4test-suivi-de-prod-copie.xlsm (98.36 Ko)
Le 28/02/2020 à 14:00
i20100 a écrit :

Bonjour,

à tester,

Sub Calendrier2()
Dim x As Double, y As Variant, Cell As Range
Sheets("TEST").Select
For Each Cell In Range("AT3:AT3")
    If Cell <> Empty Then
    x = Cell
    End If
    y = Application.Match(x, Range("AU2:KD2"), 0)
    MsgBox Cells(2, Range("AT2").Column + y).Address
Next Cell
End Sub

Ça fonctionne ! Je ne connaissais pas cette formule "Application.Match", dans quel cas de figure peut-on l'utiliser?

Je vais pouvoir avancer, merci beaucoup!!

Dois-je marquer le sujet comme résolu ou puis-je le garder ouvert si je rencontre de nouveaux problèmes?

Encore merci

Le 28/02/2020 à 14:45
chlotilde a écrit :

Ça fonctionne ! Je ne connaissais pas cette formule "Application.Match", dans quel cas de figure peut-on l'utiliser?

Je vais pouvoir avancer, merci beaucoup!!

Dois-je marquer le sujet comme résolu ou puis-je le garder ouvert si je rencontre de nouveaux problèmes?

Encore merci

1 - c'est la fonction EQUIV de la feuille de calcul

2 - si la question porte sur le même sujet "Rechercher une date dans calendrier " tu peux la poser ici.

Le 04/03/2020 à 10:11

Bonjour, je reviens vers vous car j'ai bien avancé dans mon projet mais je rencontre une nouvelle difficulté.

J'ai ce code, qui fonctionne très bien et fait exactement ce que je souhaite, c'est à dire colorer les cases d'un calendrier, correspondant aux dates renseignées dans la colonne "A" :

Sub Calendrier2()

Dim x As Double, y As Variant, z As Variant, Cell As Range

Sheets("SUIVI").Select

For Each Cell In Range("AY3:AY600")

If Cell <> Empty Then

x = Cell

Else: GoTo Here

End If

y = Application.Match(x, Range("AZ2:KI2"), 0)

Cells(2, Range("AY2").Column + y).Select

z = ActiveCell.Offset(Cell.Row - 2, 0).Select

Selection.Cells.Interior.Color = RGB(103, 201, 185)

Here:

Next Cell

End Sub

Seulement, je voudrais pouvoir colorer de la même manière le calendrier selon d'autres dates renseignées dans une colonne "B" en une autre couleur (et plus tard, celles d'une colonne "C", "D"...) (j'espère être claire, quoi qu'il en soit je vous joint le fichier Excel pour faciliter votre compréhension )

Ainsi, Je croyais pouvoir assez facilement copier puis coller plusieurs fois ce même code dans ma Sub, en modifiant éventuellement quelques paramètres mais pas plus (grave erreur!!).

Je souhaitais pas conséquent savoir si vous aviez une solution pour mon problème. Je ne suis pas parvenue jusqu'à présent à imbriquer plusieurs For Each, et mes autres tentatives se sont avérés peu fructueuses...

Merci d'éclairer ma lanterne et très bonne journée à vous

18test-suivi-de-prod-forum.xlsm (668.28 Ko)
Le 05/03/2020 à 02:31

Bonjour,

à tester,

Sub Calendrier3()
Dim x As Double, y As Variant, z As Variant
Dim Cella As Range, Cellb As Range
Dim w As Variant, v As Variant

Sheets("SUIVI").Select

For Each Cella In Range("AY3:AY" & Cells(Rows.Count, "AY").End(xlUp).Row)
    If Cella <> Empty Then
        x = Cella
        Else: GoTo Here1
    End If
    y = Application.Match(x, Range("AZ2:KI2"), 0)
    Cells(2, Range("AY2").Column + y).Select
    z = ActiveCell.Offset(Cella.Row - 2, 0).Select
    Selection.Cells.Interior.Color = RGB(193, 101, 185)
Here1:
Next Cella

For Each Cellb In Range("AS3:AS" & Cells(Rows.Count, "AS").End(xlUp).Row)
    If Cellb <> Empty Then
        x = Cellb
        Else: GoTo Here2
    End If
    w = Application.Match(x, Range("AZ2:KI2"), 0)
    Cells(2, Range("AY2").Column + w).Select
    v = ActiveCell.Offset(Cellb.Row - 2, 0).Select
    Selection.Cells.Interior.Color = RGB(133, 171, 155)
Here2:
Next Cellb
End Sub
Le 05/03/2020 à 13:56
i20100 a écrit :

Bonjour,

à tester,

Sub Calendrier3()
Dim x As Double, y As Variant, z As Variant
Dim Cella As Range, Cellb As Range
Dim w As Variant, v As Variant

Sheets("SUIVI").Select

For Each Cella In Range("AY3:AY" & Cells(Rows.Count, "AY").End(xlUp).Row)
    If Cella <> Empty Then
        x = Cella
        Else: GoTo Here1
    End If
    y = Application.Match(x, Range("AZ2:KI2"), 0)
    Cells(2, Range("AY2").Column + y).Select
    z = ActiveCell.Offset(Cella.Row - 2, 0).Select
    Selection.Cells.Interior.Color = RGB(193, 101, 185)
Here1:
Next Cella

For Each Cellb In Range("AS3:AS" & Cells(Rows.Count, "AS").End(xlUp).Row)
    If Cellb <> Empty Then
        x = Cellb
        Else: GoTo Here2
    End If
    w = Application.Match(x, Range("AZ2:KI2"), 0)
    Cells(2, Range("AY2").Column + w).Select
    v = ActiveCell.Offset(Cellb.Row - 2, 0).Select
    Selection.Cells.Interior.Color = RGB(133, 171, 155)
Here2:
Next Cellb
End Sub

Ça fonctionne! Merci beaucoup pour votre aide, encore une fois

Rechercher des sujets similaires à "rechercher date calendrier"