XL pour MAC Recherche Date

[CM1090]

Bonjour,
Après beaucoup de recherches (...), je ne trouve pas la solution à mon problème, qui paraît pourtant être la base ...
Enfin bon, voilà :
En rentrant une date dans la cellule Q5, je veux en activant la macro "AllerA", à l'aide du bouton bleu, me rendre à la date correspondante dans la colonne F. Si il y a plusieurs dates identiques (c'est quasiment toujours le cas), l'idéal serait de choisir la première ou la dernière (j'ai une préférence pour la dernière mais ce n'est pas le plus important).
Le code est plus bas mais je ne vois pas où sont mes erreurs. Merci aux bonnes âmes qui voudront bien se pencher sur mon problème.
Christophe


Sub AllerA()
'
' AllerA Macro

Dim dateRecherchee As Date
dateRecherchee = DateValue(Range("Q5").Value)

Dim cell As Range
Dim firstAddress As String
Dim count As Integer

With Columns("F:F")
Set cell = .Find(What:=dateRecherchee, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not cell Is Nothing Then
firstAddress = cell.Address
count = 1
Do
If cell.Value = dateRecherchee Then
cell.Select
Exit Do
End If
Set cell = .FindNext(cell)
count = count + 1
Loop While Not cell Is Nothing And cell.Address <> firstAddress
Else
MsgBox "Rien à cette date !!!!" & vbNewLine & "Nombre de cellules trouvées : " & count
End If
End With

Range("F1").Select
Application.CutCopyMode = False

End Sub

 

[JHA]

Bonjour à tous,

Avec un filtre avancé

JHA

 

[Bernard_XLD]

Bonjour cm1090, JHA, le forum

Pas testé sur Mac mais cela devrait fonctionner comme cela.

Cordialement, @+

Sub AllerA()
'
' AllerA Macro

Dim Cellule_en_Cours As Range, Cellule_Mem$, Plage_Ref As Range, Date_Recherchee$

Date_Recherchee = Range("Q5").Text
With Range("F10:F" & Range("F" & Rows.Count).End(xlUp).Row)
    Set Cellule_en_Cours = .Find(What:=Date_Recherchee, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Cellule_en_Cours Is Nothing Then
        MsgBox "Rien à cette date : " & Date_Recherchee, vbInformation + vbOKOnly
    Else
        Set Plage_Ref = Cellule_en_Cours
        Cellule_Mem = Cellule_en_Cours.Address
        Do
            Set Cellule_en_Cours = .FindNext(after:=Cellule_en_Cours)
            If Cellule_en_Cours Is Nothing Then Exit Do Else Set Plage_Ref = Union(Cellule_en_Cours, Plage_Ref)
        Loop Until Cellule_en_Cours.Address = Cellule_Mem
        With Plage_Ref
            MsgBox .Count & " cellules trouvées !" & vbLf & "Je vais à la dernière en " & .Areas(1)(.Areas(1).Count).Address, vbInformation + vbOKOnly
            .Areas(1)(.Areas(1).Count).Select
        End With
    End If
End With
End Sub

 

[CM1090]

Hey ! Super ! Bravo !
Les couleurs de surlignage pour les début et fin de la même date sont super !
Est-on vraiment obligé de créer 2 tableaux connexes ?
Ceci n'est pas le tableau d'origine. Le fichier concerné est beaucoup plus gros avec "pas de place pour rajouter des choses"
Est-ce qu'il est possible de n'avoir qu'une macro qui va chercher la date correspondante à la cellule Q5 dans la colonne F, de s'y rendre, et, au maxi, de la surligner ?

 

[CM1090]

Bonjour cm1090, JHA, le forum

Pas testé sur Mac mais cela devrait fonctionner comme cela.

Cordialement, @+

Sub AllerA()
'
' AllerA Macro

Dim Cellule_en_Cours As Range
Dim Plage_Ref As Range
Dim Date_Recherchee$
Date_Recherchee = Range("Q5").Text

With Columns("F:F")
    Set Cellule_en_Cours = .Find(What:=Date_Recherchee, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not Cellule_en_Cours Is Nothing Then
        Set Plage_Ref = Cellule_en_Cours
        Do
            Set Cellule_en_Cours = .FindNext(after:=Cellule_en_Cours)
            If Not Cellule_en_Cours Is Nothing Then
                Set Plage_Ref = Union(Plage_Ref, Cellule_en_Cours)
            End If
        Loop Until Cellule_en_Cours Is Nothing Or Plage_Ref.Address Like Cellule_en_Cours.Address & "*"
        MsgBox Plage_Ref.count & " cellules trouvées !" & vbLf & "Je vais à la dernière " & Plage_Ref(Plage_Ref.count).Address, vbInformation + vbOKOnly
        Plage_Ref(Plage_Ref.count).Select
    Else
        MsgBox "Rien à cette date !!!!" & vbLf & Date_Recherchee, vbInformation + vbOKOnly
    End If
End With
End Sub

merci beaucoup, je teste ça .... avant d'aller à la plage !!!!! hahahahaha

 

[Bernard_XLD]

Est-ce qu'il est possible de n'avoir qu'une macro qui va chercher la date correspondante à la cellule Q5 dans la colonne F, de s'y rendre, et, au maxi, de la surligner ?

Cette version sélectionne toutes les cellules trouvées, les passe en fond vert et active la dernière.

Cordialement, @+

Sub AllerA2()
'
' AllerA Macro

Dim Cellule_en_Cours As Range, Cellule_Mem$
Dim Plage_Ref As Range
Dim Date_Recherchee$

Date_Recherchee = Range("Q5").Text
With Range("F9:F" & Range("F" & Rows.Count).End(xlUp).Row)
    Set Cellule_en_Cours = .Find(What:=Date_Recherchee, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Cellule_en_Cours Is Nothing Then
        MsgBox "Rien à cette date : " & Date_Recherchee, vbInformation + vbOKOnly
    Else
        Set Plage_Ref = Cellule_en_Cours
        Cellule_Mem = Cellule_en_Cours.Address
        Do
            Set Cellule_en_Cours = .FindNext(after:=Cellule_en_Cours)
            If Cellule_en_Cours Is Nothing Then Exit Do Else Set Plage_Ref = Union(Cellule_en_Cours, Plage_Ref)
        Loop Until Cellule_en_Cours.Address = Cellule_Mem
        With Plage_Ref
            MsgBox .Count & " cellules trouvées !" & vbLf & "Je vais à la dernière en " & .Areas(1)(.Areas(1).Count).Address, vbInformation + vbOKOnly
            .Select
            .Interior.Color = 9359529
            .Areas(1)(.Areas(1).Count).Activate
        End With
    End If
End With
End Sub

 

[CM1090]

Wahoooo ! C'est exactement ça !!! Bravissimo !
Je parlais de la plage parce que sur mon écran, là où le code dit "je vais à la", ça passe à la ligne et ça donne "je vais à la plage " ! hahaha. Je pensais que vous aviez rajouté une blague dans les messages !

 

[CM1090]

Cette version sélectionne toutes les cellules trouvées, les passe en fond vert et active la dernière.

Cordialement, @+

Sub AllerA()
'
' AllerA Macro

Dim Cellule_en_Cours As Range
Dim Plage_Ref As Range
Dim Date_Recherchee$
Date_Recherchee = Range("Q5").Text

With Columns("F:F")
    .Interior.Pattern = xlNone
    Set Cellule_en_Cours = .Find(What:=Date_Recherchee, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not Cellule_en_Cours Is Nothing Then
        Set Plage_Ref = Cellule_en_Cours
        Do
            Set Cellule_en_Cours = .FindNext(after:=Cellule_en_Cours)
            If Not Cellule_en_Cours Is Nothing Then
                Set Plage_Ref = Union(Plage_Ref, Cellule_en_Cours)
            End If
        Loop Until Cellule_en_Cours Is Nothing Or Plage_Ref.Address Like Cellule_en_Cours.Address & "*"
        MsgBox Plage_Ref.count & " cellules trouvées !" & vbLf & "Je vais à la dernière " & Plage_Ref(Plage_Ref.count).Address, vbInformation + vbOKOnly
        Plage_Ref.Select
        Plage_Ref.Interior.Color = 9359529
        Plage_Ref(Plage_Ref.count).Activate
    Else
        MsgBox "Rien à cette date !!!!" & vbLf & Date_Recherchee, vbInformation + vbOKOnly
    End If
End With
End Sub

Super ! Ca fonctionne très bien ! Je conserve néanmoins la version sans couleur.

 

[Phil69970]

Bonjour à tous

Voila ma version si j'ai tout compris
En option j'ai mis la date en couleur voir le code pour le désactiver la ligne

Merci de ton retour

@Phil69970

 

[CM1090]

Bonjour à tous

Voila ma version si j'ai tout compris
En option j'ai mis la date en couleur voir le code pour le désactiver la ligne

Merci de ton retour

@Phil69970

Bonjour,
Merci beaucoup pour t'être penché sur mon problème !
Ta solution fonctionne. Avec surlignage de la cellule destination ! Bravo !
Cependant, dans ma configuration, j'ai besoin que la cellule correspondante à Q5 devienne la cellule active (il manque donc cette ligne dans ton code). Ceci, tout simplement parce que dans mon "vrai" fichier, j'ai plusieurs centaines de lignes ! Et comme je suis fainéant pour le scrolling ...
La solution de Bernard_XLD est vraiment ce que je voulais avoir.
Mais autrement, ton code fonctionne très bien. Merci encore.
Christophe

 

[CM1090]

merci beaucoup, je teste ça .... avant d'aller à la plage !!!!! hahahahaha

 

[Bernard_XLD]

Bonjour

J'ai mis à jour les codes des posts 3 et 6, il y avait un bug dans la sélection de la dernière cellule si la succession des cellules trouvées n'était pas continue, pas le cas du fichier de ce fil mais autant avoir un code polyvalent.

Cordialement, @+

 

[Phil69970]

Bonjour le forum

@CM1090

j'ai besoin que la cellule correspondante à Q5 devienne la cellule active

Ce n'est pas le contraire de ce que tu as écris ici

me rendre à la date correspondante dans la colonne F.

mon code te rend bien à la colonne F et à la dernière ligne comme demandé

l'idéal serait de choisir la première ou la dernière (j'ai une préférence pour la dernière

maintenant si tu veux que la cellule active soit toujours la cellule Q5 il suffit de mettre Q5 à la place de Range("F" & i).Select tout simplement

If Range("F" & i) = Range("Q5") Then
Range("F" & i).Select
Range("Q5").Select
Range("F" & i).Interior.Color = vbRed 'Optionnel
Exit Sub
End If

@Phil69970