Macro vba rechercher date par rapport a une annee [Résolu/Fermé]

Messages postés
20
Date d'inscription
mardi 25 avril 2017
Statut
Membre
Dernière intervention
24 juillet 2017
- - Dernière réponse : elio55
Messages postés
20
Date d'inscription
mardi 25 avril 2017
Statut
Membre
Dernière intervention
24 juillet 2017
- 26 avril 2017 à 09:31
SVP URGENT !!
Grâce a une macro je saisi l'année d'une date (imputbox) en espérant que cela me preselectionne toutes les cellules ou on aurait cette année .cependant elle me présélectionne qu'une seule date précise (la première qu'elle trouve ) et non toutes les dates ou cette année apparait !

voici le code

Sub date_2()
Dim X As Variant
Dim Cel As Range
X = InputBox("date")
Set Cel = Sheets("Feuil1").UsedRange.Find(X, lookat:=xlPart)
Cel.Select
End Sub
Afficher la suite 

3 réponses

Messages postés
4602
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
18 novembre 2019
118
0
Merci
Bonjour Elio, bonjour le forum,

Le code que je te propose va colorier les cellules en rouge :

Sub date_2()
Dim X As Variant
Dim Cel As Range
X = Application.InputBox("Année de la date", "ANNÉE", Type:=1)
If X = False Then Exit Sub
Set Cel = Sheets("Feuil1").UsedRange.Find(X, lookat:=xlPart)
If Not Cel Is Nothing Then
    PA = Cel.Address
    Do
        Cel.Interior.ColorIndex = 3
        Set Cel = Sheets("Feuil1").UsedRange.FindNext(Cel)
    Loop While Not Cel Is Nothing And Cel.Address <> PA
End If
End Sub

Messages postés
15980
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
20 novembre 2019
2824
0
Merci
Bonjour Elio, Thautheme

un exemple à adapter avec X=textbox où on boucle que sur lr nombre de X

Option Explicit
'---------
Sub modifier_si()
Dim zone As Range, cellule As Range, nbre As Integer
Dim Cptr As Integer

Application.ScreenUpdating = False
Set zone = ActiveSheet.Range("B2:F9")
nbre = Application.CountIf(zone, "*" & X & "*")

With zone
Set cellule = .Find(what:=X, LookIn:=xlValues)
For Cptr = 1 To nbre
cellule = cellule & " trouvé!"
Set cellule = .FindNext(cellule)
Next
End With

End Sub



,

 Michel
Messages postés
20
Date d'inscription
mardi 25 avril 2017
Statut
Membre
Dernière intervention
24 juillet 2017
0
Merci
Mercii beacoup les amis c'est exactement ce que je voulais :D