Recherche date à l'ouverture d'un fichier Excel

Une façon de faire :

Trouve la date sur la ligne 5 qui correspond à ton critère, la date
la plus proche de la date d'aujourd'hui, mais avec un écart d'au moins 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)
A = 1
For Each C In Rg
If IsDate(C) Then
If Date - C.Value > 1461 Then
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 UBound(T) > 0 Then
.Range(Application.Index(Adr, _
Application.Match(Application.Min(T), T, 0), 1)).Select
End If
End With
End Sub
'--------------------------------------



MichD
--------------------------------------------
"ze_louloux" a écrit dans le message de groupe de discussion : 4dfdb778$0$30751$ba4acef3@reader.news.orange.fr...

Bonjour
Effectivement sur la ligne 5, il y a format date, format texte et format
monétaire

Ci-joint le fichier

http://www.cijoint.fr/cjlink.php?file=cj201106/cijc2t1bYT.xls

Merci de m'aider autant



Le 18/06/2011 20:19, MichD a écrit :

La procédure fonctionne correctement sur une version 2002

SAUF SI :

a ) si une des cellules de la ligne 5 est au format "Texte" ou contient du texte.
b ) Une date répondant à ton critère n'existe pas en ligne 5:S .
Dans les 2 cas, cela génère une erreur : "Erreur d'exécution 1004"

Si tu veux passer outre ces 2 types d'erreur, tu ajoutes en début de macro : On Error Resume Next
Évidement, aucune date ne sera sélectionnée.

Sinon, publie ton fichier en utilisant cette adresse cijoint.fr en ne laissant que la feuille et la ligne
contenant les dates. Tu nous retournes ici, l'adresse que tu auras obtenue.

MichD
--------------------------------------------

Correction : J'avais oublié d'incrémenter la variable A dans la boucle!
;-)

'---------------------------------------
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 UBound(T) > 0 Then
.Range(Application.Index(Adr, _
Application.Match(Application.Min(T), T, 0), 1)).Select
End If
End With
End Sub
'---------------------------------------


MichD
--------------------------------------------

j'ai tjrs erreur
Je te joins le fichier

http://www.cijoint.fr/cjlink.php?file=cj201106/cijnFA5Ka8.xls


Nota : Sur la ligne 5, il suffit d'en sélectionner une seule de plus de
4 ans (au cas ou il y aurait plusieurs)
Les autres je pourrais les avoir a chaque allumage de l'ordi,
aujourd'hui, demain, après demain, dans un mois...........

merci




Le 19/06/2011 14:17, MichD a écrit :

Correction : J'avais oublié d'incrémenter la variable A dans la boucle!
;-)

'---------------------------------------
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 UBound(T)> 0 Then
.Range(Application.Index(Adr, _
Application.Match(Application.Min(T), T, 0), 1)).Select
End If
End With
End Sub
'---------------------------------------


MichD
--------------------------------------------

Désolé, j'aurais dû tester...

Modifie à la procédure, seulement ces 3 lignes :
'----------------------------
If UBound(T)> 0 Then
.Range(Application.Index(Adr, _
Application.Match(Application.Min(T), T, 0), 1)).Select
End If
'----------------------------

Pour :
'----------------------------
If A > 0 Then
.Range(Adr(Application.Match(Application.Min(T), T, 0))).Select
End If
'----------------------------

MichD
--------------------------------------------

Ta question initiale était :

| Sélectionner une date (si elle existe) antérieure à
| aujourd'hui de 4 ans sur la 5ème ligne

Si tu veux la date la plus rapprochée à aujourd'hui - 4 ans, tu dois
utiliser Max au lieu de Min dans :
.Range(Adr(Application.Match(Application.Max(T), T, 0))).Select

Ceci te donne la plus la date la plus éloignée d'aujourd'hui - 4 ans
.Range(Adr(Application.Match(Application.Min(T), T, 0))).Select


MichD
--------------------------------------------

Ça marche
Super
MERCI







Le 20/06/2011 13:00, MichD a écrit :

Ta question initiale était :

| Sélectionner une date (si elle existe) antérieure à
| aujourd'hui de 4 ans sur la 5ème ligne

Si tu veux la date la plus rapprochée à aujourd'hui - 4 ans, tu dois
utiliser Max au lieu de Min dans :
.Range(Adr(Application.Match(Application.Max(T), T, 0))).Select

Ceci te donne la plus la date la plus éloignée d'aujourd'hui - 4 ans
.Range(Adr(Application.Match(Application.Min(T), T, 0))).Select


MichD
--------------------------------------------