Discussion :

[fanfan89]

Bonjour à tous,

je travaille sur un classeur dans lequel il y a une série de dates assez longue en colonne A. La série commence en A19.

je souhaite, à partir d'une date qu'on remplit manuellement sur la case C4 de ma feuille, retrouver le numéro de la ligne dans ma série en colonne A qui correspond à la date que j'ai rentré en C4. Je souhaite renvoyer ce numéro de ligne dans la case C5.

Dans l'hypothèse où la date que j'ai rentré en C4 ne se trouve pas dans ma série en colonne A, je voudrais retrouver le numéro de ligne de la date la plus proche.

J'ai essayé de mettre au point un début de macro en me servant de la fonction Find, mais sans résultat car même en définissant un Range pour ma recherche (en colonne A), la fonction Find me renvoie toujours la date située en C4...

Pouvez-vous m'aider svp?

Merci!

[pgz]

Bonjour.

Une précision : en colonne A les dates sont dans un ordre particulier ?

PGZ

[helas]

Bonjour,
avec un exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub test()
 Dim sh As Worksheet, d As Date, l As Long
 
 Set sh = Worksheets("Feuil1")
 d = sh.Range("C4")
 
 n = 0
 Do until n>20
  l = ligne(sh, d + n)
  If l > 0 Then sh.Range("C5") = l: Exit Do
  l = ligne(sh, d - n)
  If l > 0 Then sh.Range("C5") = l: Exit Do
  n = n + 1
 Loop
End Sub
 
Function ligne(sh As Worksheet, d As Date) As Long
 ligne = 0
 Set c = sh.Range("C10:C100").Find(d, LookIn:=xlValues)
 If Not c Is Nothing Then ligne = c.Row
End Function

la procedure envoie la date à la fonction ligne qui doit lui retourner la ligne
si celle-ci n'est pas trouvée, on incremente la date si toujours pas trouvée on décremente la date jusqu'à l'obtention d'un résultat. on limite la recherche au 20 jours suivant ou précédent la date à rechercher
la fonction retourne la ligne de la date trouvée sinon 0

[mercatog]

Pour compléter la solution proposée par Helas et s'inspirant d'elle, j'ai pris l'évènement change de la feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dte As Date
Dim Plage As Range, c As Range
Dim i As Integer, n As Integer
Dim Ligne As Long
 
If Target.Address = "$C$4" Then
    If Target.Value <> "" And IsDate(Target.Value) Then
        Dte = Target.Value
        Set Plage = Range("A19", Cells(Rows.Count, "A").End(xlUp))
        Dte = IIf(DateDiff("d", Dte, Application.Min(Plage)) > 0, Application.Min(Plage), Dte)
        Dte = IIf(DateDiff("d", Dte, Application.Max(Plage)) < 0, Application.Max(Plage), Dte)
        Do
            Ligne = RechercheDate(Plage, DateAdd("d", n, Dte))
            If Ligne > 0 Then Exit Do
            Ligne = RechercheDate(Plage, DateAdd("d", -n, Dte))
            If Ligne > 0 Then Exit Do
            n = n + 1
        Loop
        Set Plage = Nothing
    End If
End If
Application.EnableEvents = False
Range("C5").Value = IIf(Ligne = 0, "", Ligne)
Application.EnableEvents = True
End Sub
 
 
Function RechercheDate(LaPlage As Range, LaDate As Date) As Long
Dim c As Range
 
Set c = LaPlage.Find(LaDate)
If Not c Is Nothing Then
    RechercheDate = c.Row
    Set c = Nothing
End If
End Function

Qui traite aussi les dates hors plage

[fanfan89]

Merci helas, ton code fonctionne très bien!

j'ai juste eu un petit souci dans le format des dates car mon pack office est en anglais (jour / mois inversé) mais ça tu n'y étais pour rien