Sélectionner une cellule contenant une date au format différent

Version imprimable

06/01/2023, 12h38
modus57

Sélectionner une cellule contenant une date au format différent

Bonjour,

La première feuille contient une cellule contenant une date au format "jj-mm-aa", je souhaiterai sélectionner la même date dans la deuxième feuille qui contient une plage cellules contenant des dates au format "jjj jj".

Pour ce faire je sélectionne et modifie le format de cette plage de cellules :

Code:

Selection.NumberFormat = "m/d/yyyy"

Et ensuite je rétabli le format de celle-ci :

Code:

Selection.NumberFormat = "ddd dd"

Existe-t-il une meilleure solution ?

Merci d’avance pour votre aide et réponse.

Modus57
06/01/2023, 16h34
Tête de chat

Bonjour,

si tu ne fais que sélectionner, je ne vois pas pourquoi il y a besoin de modifier le format.

Il doit se passer autre chose entre tes deux Selection.NumberFormat qui doit nécessiter ou semble nécessiter de changer le format...

Accessoirement le vba devrait rarement contenir des select et des selection. .

Donc : dis nous en plus sur ce que tu veux faire avec cette date et qui ne marche pas si tu ne fais pas ces changements de format.

Cordialement.

Bonjour, bonne heureuse année,

Je me suis mal exprimé voilà ma solution :

Le clic sur un bouton dans la Feuil1 recherche la date de la première cellule visible de la colonne 1 du tableau filtré et la sélectionne dans la Feuil2.
Code:

1 2 3 4 5 6 7 8 9 10 Dim Valeur_Cherchee As Date, MoisRecherche As String Valeur_Cherchee = Range("Formulaire").SpecialCells(xlCellTypeVisible).Cells(1, 1).Value 'Première cellule visible de la colonne 1 tableau filtré MoisRecherche = MonthName(Month(Valeur_Cherchee)) Application.Goto Reference:=MoisRecherche Selection.NumberFormat = "m/d/yyyy" Selection.Find(what:=CDate(Valeur_Cherchee), After:=ActiveCell, LookIn:=xlValues).Activate ActiveCell.Interior.Color = 52879367 Selection.NumberFormat = "ddd dd"
Y en a-t-il d’autre ?

08/01/2023, 15h04
modus57

Bonjour, :D

Un début d'année sans la moindre réponse. :?

Salut

Code:

Valeur_Cherchee = Range("Formulaire")...

Il vaudrait mieux préciser le classeur et la feuille sur lesquels tu travailles

Code:

Valeur_Cherchee = ThisWorkBook.Worksheets(....).Range("Formulaire")...

Pour ce qui est de ta recherche en elle-même, je ne comprends pas trop. Le format d'affichage d'une date n'a pas d'importance, si tu recherches le 3 Juillet 1990, peu importe le formatage que tu mets en place dans ta cellule, 3/7/1990, 03/07/90,.. ça reste la même date, tu ne devrais pas avoir à modifier quoi que ce soit pour la chercher. A moins que Find recherche une chaine et non une date.
Dans ce cas, utilises plutôt Format() pour modifier la date que tu recherches avec find et lui donner le format "jj-jjjj"

Plus globalement, il n'est pas utile de sélectionner une cellule ou un onglet pour modifier ou rechercher quelques choses dessus.
Plutôt que de faire un goto, utilise ta référence pour pointer la cellule ou l'onglet
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim Valeur_Cherchee as Date Dim NextCell as Range Valeur_Cherchee = ThisWorkBook.Worksheet("Feuil1").Range("Formulaire") '..... With ThisWorkBook.Worksheet("Feuil2").Range("Reference") Set NextCell = .Find(Valeur_Cherchee ,After:=.cells(1,1), LookIn:=xlValues) 'Essai comme ça avec la variable typée Date Set NextCell = .Find(Format(Valeur_Cherchee,"jj-jjjj") ,After:=.cells(1,1), LookIn:=xlValues) 'Sinon comme ça NextCell.Interior.Color = 52879367 End With
Je n'ai pas testé le code, c'est un code de principe.

[Edit]
Bon ça m'intriguais, j'ai fait quelques essais.
alors il faut utiliser xlFormulas et non xlValues... Sinon, en effet Find cherche dans ce qui est affiché et ne tient pas compte de la donnée brute.

Code:

.Find(Valeur_Cherchee ,.cells(1,1), xlFormulas, xlWhole)

[/Edit]
++
Qwaz

09/01/2023, 09h29
modus57

2 pièce(s) jointe(s)

Bonjour Qwazerty,

J'ai testé votre code :

Pièce jointe 632121

Range("Formulaire") est un tableau structuré

Ça bug

Pièce jointe 632122

Salut
Si vous n'avez pas de tableau structuré, déterminez le Range du tableau

Code:

1
2
3
4
5
With ThisWorkbook.Worksheet("formulaire")
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set rng = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
End With

Bonjour hyperion13,

Merci pour votre réponse j'en prends bonne note.

J'ai un peu amélioré mon code en modifiant le format de la plage mois, mais dans l'obligation d'activer la feuille2 "Calendrier" et le mois "MoisRecherche", cette obligation à prime abord est incontournable si la macro est lancée depuis la feuille2 !
Code:

1 2 3 4 5 6 7 8 Dim Valeur_Cherchee As Date, MoisRecherche As String Valeur_Cherchee = Range("Formulaire").SpecialCells(xlCellTypeVisible).Cells(1, 1).Value 'Première cellule visible de la colonne 1 tableau filtré MoisRecherche = MonthName(Month(Valeur_Cherchee)) Sheets("Calendrier").Range(MoisRecherche).NumberFormat = "m/d/yyyy" Sheets("Calendrier").Range(MoisRecherche).Activate Sheets("Calendrier").Range(MoisRecherche).Find(what:=CDate(Valeur_Cherchee), After:=ActiveCell, LookIn:=xlValues).Interior.Color = 52879367 Sheets("Calendrier").Range(MoisRecherche).NumberFormat = "ddd dd"

1 pièce(s) jointe(s)

Salut

Pouvez-vous mettre un fichier démo à dispo, histoire de voir l'organisation exact.

Si vous travaillez avec un tableau structuré, il est possible de le pointer via

Code:

ThisWorkbook.worksheets("....").ListObjects("Formulaire")

La propriété DataBodyRange représente la partie du tableau contenant les données, si données il y a, sinon cette propriété est à Nothing

Vous pouvez faire quelque choses comme ça
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub test() Dim aCell As Range Dim VariableX As Boolean '"Feuil1" est le codename de la feuille (ça marche pareil avec ThisWorkbook.Worksheets("NomDeL'Onglet") With Feuil1.ListObjects("Tableau1") If Not .DataBodyRange Is Nothing Then For Each aCell In .ListColumns("Col1").DataBodyRange.SpecialCells(xlCellTypeVisible) If aCell.Value = 4 Then 'Code... VariableX = True End If Next End If End With End Sub
Pour utiliser le codename des feuille, c'est ici
Pièce jointe 632185

Il existe du tuto sur les tableaux structurés ainsi que des blogs, je pense à celui de Pierre fauconnier, vous pourriez y trouver des sources d'inspiration pour écrire votre code ;)

Attention avec les méthodes qui retourne un cellule, Find retourne une cellule... si elle en trouve une qui correspond, sinon c'est nothing et votre code va planter
Sans parler de la fonction du code, n'oubliez pas de préciser sur quoi vous travaillez (il manque le classeur dans votre code)
Code:

1 2 3 4 Sheets("Calendrier").Range(MoisRecherche).NumberFormat = "m/d/yyyy" Sheets("Calendrier").Range(MoisRecherche).Activate Sheets("Calendrier").Range(MoisRecherche).Find(what:=CDate(Valeur_Cherchee), After:=ActiveCell, LookIn:=xlValues).Interior.Color = 52879367 Sheets("Calendrier").Range(MoisRecherche).NumberFormat = "ddd dd"
Ecrivez plutôt
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim aCellFinded as Range With ThisWorkbook.Sheets("Calendrier").Range(MoisRecherche) .NumberFormat = "m/d/yyyy" .Activate Set aCellFinded = .Find(what:=CDate(Valeur_Cherchee), After:=ActiveCell, LookIn:=xlValues) 'On vérifie qu'un cellule a été trouvée If not acellfinded = nothing then acellFinded.Interior.Color = 52879367 end if .NumberFormat = "ddd dd"
Et à mon avis
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim aCellFinded as Range With ThisWorkbook.Sheets("Calendrier").Range(MoisRecherche) '.NumberFormat = "m/d/yyyy" '.Activate Set aCellFinded = .Find(what:=Format(Valeur_Cherchee,"ddd dd"), After:=ActiveCell, LookIn:=xlValues) 'On vérifie qu'un cellule a été trouvée If not acellfinded = nothing then acellFinded.Interior.Color = 52879367 end if '.NumberFormat = "ddd dd"
++
Qwaz

1 pièce(s) jointe(s)

Bonjour Qwarzety,

Ci-joint mon fichier dépouillé au maximum pour une question de confidentialité.

Quand j’exécute votre code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub A_TestWeb()
    Dim Valeur_Cherchee As Date, MoisRecherche As String
    Valeur_Cherchee = Range("Formulaire").SpecialCells(xlCellTypeVisible).Cells(1, 1).Value 'Première cellule visible de la colonne 1 tableau filtré
    MoisRecherche = MonthName(Month(Valeur_Cherchee))
 
    Dim aCellFinded As Range
    With ThisWorkbook.Sheets("Calendrier").Range(MoisRecherche)
        .NumberFormat = "m/d/yyyy"
        '.Activate
        Set aCellFinded = .Find(what:=Format(Valeur_Cherchee, "ddd dd"), After:=ActiveCell, LookIn:=xlValues)
        'On vérifie qu'un cellule a été trouvée
        If Not aCellFinded Is Nothing Then
            aCellFinded.Interior.Color = 52879367
        End If
        .NumberFormat = "ddd dd"
    End With
End Sub

Ça bug ?
Pièce jointe 632213
En revanche avec mon code fonctionne :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub A_TestDate_2()
    Dim Valeur_Cherchee As Date, MoisRecherche As String
    Valeur_Cherchee = Range("Formulaire").SpecialCells(xlCellTypeVisible).Cells(1, 1).Value 'Première cellule visible de la colonne 1 tableau filtré
    MoisRecherche = MonthName(Month(Valeur_Cherchee))
 
'    Application.Goto Reference:=MoisRecherche
'    Selection.NumberFormat = "m/d/yyyy"
    Sheets("Calendrier").Range(MoisRecherche).NumberFormat = "m/d/yyyy"
'    Selection.Find(what:=CDate(Valeur_Cherchee), After:=ActiveCell, LookIn:=xlValues).Activate
    Sheets("Calendrier").Activate
    Sheets("Calendrier").Range(MoisRecherche).Activate
    Sheets("Calendrier").Range(MoisRecherche).Find(what:=CDate(Valeur_Cherchee), After:=ActiveCell, LookIn:=xlValues).Activate
'    Selection.NumberFormat = "ddd dd"
    Sheets("Calendrier").Range(MoisRecherche).NumberFormat = "ddd dd"
    TransfertFormulaireNote_1
End Sub

Merci pour votre participation @+

10/01/2023, 18h12
Qwazerty

Salut

Je ne vois pas de fichier joint, sans doute un oubli.

C'est tout à fait possible que le code tel quel ne fonctionne pas, je n'ai pas pu le tester.
Je pense que le problème vient de After:=ActiveCel, le mieux est de carrément supprimer de paramètre, sinon il faut lui faire pointer la 1er cellule de ta colonne où se trouvent les dates.

Je continue à penser que tu t'embêtes pour rien, as-tu fait un essai avec xlFormulas comme indiqué au message n°5 ?

++
Qwaz
10/01/2023, 18h43
modus57

1 pièce(s) jointe(s)

Voici le fichier que j'ai oublier de joindre.
Navré @+

Salut

Une solution

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub A_TestWeb() 'lien 10-01-23 : https://www.developpez.net/forums/d2144014/logiciels/microsoft-office/excel/macros-vba-excel/selectionner-cellule-contenant-date-format-different/
    Dim Valeur_Cherchee As Date, MoisRecherche As String
    Dim LeMois As Byte, LeJour As Byte
    Dim aCellFinded As Range
 
    Valeur_Cherchee = Range("Formulaire").SpecialCells(xlCellTypeVisible).Cells(1, 1).Value 'Première cellule visible de la colonne 1 tableau filtré
    LeMois = Month(Valeur_Cherchee)
    LeJour = Day(Valeur_Cherchee)
 
    With ThisWorkbook.Sheets("Calendrier").Range("A4").Offset(LeJour, LeMois)
        .Interior.Color = 52879367
        .Worksheet.Activate
        .Select
    End With
End Sub

++
Qwaz

Salut

Sinon, une solution avec recherche avec un code plus robuste, ça donnerait ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub A_TestWeb2() 'lien 10-01-23 : https://www.developpez.net/forums/d2144014/logiciels/microsoft-office/excel/macros-vba-excel/selectionner-cellule-contenant-date-format-different/    Dim Valeur_Cherchee As Variant, MoisRecherche As String
    Dim LeMois As Byte, LeJour As Byte
    Dim aCellFinded As Range
 
    'On pointe le tableau
    With Feuil1.ListObjects("Formulaire")
        'On vérifie qu'il a du contenu
        If .ListRows.Count > 0 Then
            'On regarde la date à rechercher
            Valeur_Cherchee = .DataBodyRange.SpecialCells(xlCellTypeVisible).Cells(1, 1).Value 'Première cellule visible de la colonne 1 tableau filtré
            'On vérifie qu'il s'agit d'une date valide
            If VarType(Valeur_Cherchee) And vbDate = vbDate Then
                'On modifie la forme de la rrecherche
                Valeur_Cherchee = Replace(Format(Valeur_Cherchee, "ddd dd"), ".", "")
                'On pointe le calendrier
                With Feuil2 'ThisWorkbook.Worksheets("Calendrier")
                    'On recherche la date
                    Set aCellFinded = .Range("Calendrier").Find(Valeur_Cherchee, LookIn:=xlValues, MatchCase:=False)
                    'On regarde si la cellule a été trouvée
                    If Not aCellFinded Is Nothing Then
                        'On la coloris
                        aCellFinded.Interior.Color = 52879367
                        'On active l'onglet
                        .Activate
                        'On selectionne la cellule
                        aCellFinded.Select
                    End If
                End With
            End If
        End If
    End With
End Sub

'Il faudrait ajouter une gestion de application.screenupdating peut-être

Vous pouvez aussi juste copier la date à rechercher dans un cellule cible de la feuille calendrier et vous en servir pour mettre une mise en forme automatique sur le calendrier pour colorier la cellule.

Autre option, ajouter une colonne en mettant une formule Lien_hypertext qui pointe sur la cellule correspondante au décalage jour et mois (comme mon code précédent), un click sur le lien vous enverrais directement sur la bonne cellule du calendrier.

Les deux dernières possibilités peuvent être mixées, la MFC pourrait directement prendre en compte la cellule A4 de formulaire, comme ça 0 VBA. Il est, à mon avis, plus profitable "d'épuiser" les options qu'offre Excel avant de passer à du VBA

++
Qwaz

11/01/2023, 11h27
modus57

Bonjour Qwazerty,

Merci pour le temps que vous avez consacré à cette discussion et pour vos excellentes réponses.

Je viens de tester votre solution du post #13 elle fonctionne très bien peu importe si la feuille est active ou pas.

Citation:

Vous pouvez aussi juste copier la date à rechercher dans un cellule cible de la feuille calendrier et vous en servir pour mettre une mise en forme automatique sur le calendrier pour colorier la cellule.
Il est, à mon avis, plus profitable "d'épuiser" les options qu'offre Excel avant de passer à du VBA

C’est très intéressant, en revanche pour le processus : dans la Feuil2 « Calendrier » une cellule contient la formule « =Formulaire!A4 », mais comment utiliser celle-ci pour colorier la cellule correspondante à cette date dans le calendrier ?
11/01/2023, 15h31
Qwazerty

1 pièce(s) jointe(s)

Salut

Simplement en ajoutant une MFC (Mise En Forme Conditionnelle) sur l'ensemble de la zone calendrier.

Pour la mettre ne place, il faut sélectionner la zone Calendrier, puis ajouter une MFC (Bandeau Accueil, section Styles, bouton Mise en Forme Conditionnelle)

Pièce jointe 632315

++
Qwaz

1 pièce(s) jointe(s)

Bonjour Qwazerty,

Encore une fois merci pour votre contribution. :ccool:

Je préfère rechercher dans une cellule la valeur de la première cellule visible dans la colonne « Date » du tableau « Formulaire » filtré avec la formule suivante par exemple :
=INDEX(Formulaire[[ DATE]];MIN(SI(SOUS.TOTAL(3;DECALER(Formulaire!A3;LIGNE(Formulaire[[ DATE]])-LIGNE(Formulaire!A3);0));LIGNE(Formulaire[[ DATE]])-LIGNE(Formulaire!A3)+1)))[/CODE]

Plus tôt que d’avoir la formule « =Formulaire!A4 » dans cette même cellule, dans ces 2 cas c’est toujours une cellule qui sera coloriée.

Ce n’est pas exactement ce que je veux faire, le but étant de conserver dans le calendrier les cellules coloriées équivalentes et en fonction de la date de la première cellule et première colonne du tableau « Formulaire » filtré, puis insérer un commentaire et copier dans celui-ci les données provenant du tableau.

Pièce jointe 632371
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub TransfertFormulaireNote_1() Dim rng As Range, ce As Range Dim r As Long, c As Integer Dim t As String Call SupprimeNote Set rng = Range("Formulaire").SpecialCells(xlCellTypeVisible) With rng For r = 1 To .Rows.Count For c = 1 To .Columns.Count t = t & .Cells(r, c).Text & " " Next t = t & vbLf Next End With rng.ClearComments With ActiveCell .AddComment .Comment.Text Text:=t .Comment.Shape.TextFrame.AutoSize = True End With Set rng = Nothing: ActiveCell.Interior.Color = 52879367 End Sub