XL pour MAC Recherche Date

CM1090 · 8 Février 2023

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

Bernard_XLD · 8 Février 2023

Bonjour cm1090, JHA, le forum

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

Cordialement, @+

VB:

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 =...

JHA · 8 Février 2023

Bonjour à tous,

Avec un filtre avancé

JHA

Bernard_XLD · 8 Février 2023

Bonjour cm1090, JHA, le forum

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

Cordialement, @+

VB:

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 · 8 Février 2023

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 · 8 Février 2023

Bernard_XLD à dit:

Bonjour cm1090, JHA, le forum

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

Cordialement, @+

VB:

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 · 8 Février 2023

CM1090 à dit:
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, @+

VB:

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 · 8 Février 2023

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 · 8 Février 2023

Bernard_XLD à dit:

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

Cordialement, @+

VB:

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 · 8 Février 2023

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 · 9 Février 2023

Phil69970 à dit:
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 · 9 Février 2023

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

Bernard_XLD · 9 Février 2023

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 · 11 Février 2023

Bonjour le forum

@CM1090

CM1090 à dit:
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

CM1090 à dit:
me rendre à la date correspondante dans la colonne F.

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

CM1090 à dit:
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

XL pour MAC Recherche Date

CM1090

XLDnaute Nouveau

Pièces jointes

Bernard_XLD

JHA

XLDnaute Barbatruc

Pièces jointes

Bernard_XLD

XLDnaute Barbatruc

CM1090

XLDnaute Nouveau

CM1090

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

CM1090

XLDnaute Nouveau

CM1090

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Pièces jointes

CM1090

XLDnaute Nouveau

CM1090

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Discussions similaires