Recherche date à l'ouverture d'un fichier Excel
Bonjour tous
Je voudrai créer une macro
A l'ouverture d'un fichier Excel
Sur une feuille nommée "Bilan des frais"
Sélectionner une date (si elle existe) antérieure à aujourd'hui de 4 ans
sur la 5ème ligne
Exemple :
04 juil 2007 Batterie 206 145,80 € 5 avril 2009 Course Leclerc 105.30 € 9 septembre 2006 Essence 98.00 €
Merci de votre aide
essai d’être plus précis et peux être avec un fichier ce serai bien
enlève les info confidentiel et post le
a+
Bonsoir
je vous joins le fichier
A l'ouverture ne pas tenir compte du message Excel
Cliquer sur Ne pas mettre à jour
Merci
si j'ai bien compris ce que tu voulais c'est bon
je suis passer par une feuil + macro
on dois pouvoir faire qu'une macro
mais j'ai un peu de mal avec les recherche en macro
mais bon ca fonctionne
tu peux cacher la feuil 1 ca marchera quand meme
tiens nous au courant
a+
lien cjoint car sur le site ca n'a pas marché
Salut spyderpaint
Merci de m'accorder ton temps et tes connaissances
Mais on ne s'est pas compris
Je veux à l'aide d'une macro et à l'ouverture de mon fichier
Sélectionner sur la ligne 5, les dates qui ont une antériorité de plus de 4 ans
c'est a dire 18 mai 2007 5 janv 2002 8 juin 1946 par exemple
(Ceci afin de supprimer les données de plus de quatre ans sur ma feuille "Bilan des frais")
Je ne sais pas si ma requête est encore bien claire
Bonne journée
Bonjour tous
Pour info
1) pour trouver la date exacte
Sub Trouver_La_Date()
Dim X As Variant
With Worksheets("Feuil1")
.Activate
X = Application.Match(CLng(DateSerial(Year(Now()) - 4, _
Month(Now()), Day(Now()))), Range("5:5").Value2, 0)
If IsNumeric(X) Then
.Range("A5").Offset(, X - 1).Select
Else
.Range("A1").Select
End If
End With
End Sub
-- 24 Juin 2011, 09:31 --
Bonjour tous
Pour info
1) pour trouver la date antérieure de plus de 4 ans
Sub Trouver_La_Date()
Dim Rg As Range, C As Range, A As Integer
Dim T(), Adr()
With Worksheets("Bilan des frais")
.Activate
Set Rg = .Range("A5:" & .Cells(5, .Cells(5, _
.Columns.Count).End(xlToLeft).Column).Address)
For Each C In Rg
If IsDate(C) Then
If Date - C.Value > 1461 Then
A = A +1
ReDim Preserve T(1 To A)
ReDim Preserve Adr(1 To A)
T(A) = CLng(C.Value)
Adr(A) = C.Address
End If
End If
Next
If A > 0 Then
.Range(Adr(Application.Match(Application.Min(T), T, 0))).Select
End If
End With
End Sub