Discussion :

[gilou41]

Bonjour, je galère un peu
dans une feuille exel en "A" j'ai des dates (une même date peut s'y trouver plusieurs fois) et en "B","C" "D" des commentaires.
Je cherche à recuperer une date (qui peut se trouver plusieurs fois dans la feuille) et ses commentaires et copier cette recherche en "G".
Les dates et commentaires sont issues de listbox
Si quelqun à le bon code j'apprécierais car ceux que j'ai trouvé juqu'a present bug ou ne reponde pas à mon besoin
Merci d'avance

[Theze]

Bonsoir gilou41,

A mettre dans un module standard et tester :

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
38
39
40
41
42
43
44
45
46
47
48
49
50
 
Sub ChercherDate()
 
    Dim Tbl()
    Dim Plage As Range
    Dim Cel As Range
    Dim LaDate As Date
    Dim Adr As String
    Dim I As Integer
 
    'date cherchée (à adapter)
    LaDate = #10/25/2010#
 
    'plage où s'effectue la recherche de date (colonne A)
    Set Plage = Range([A1], [A65536].End(xlUp))
 
    'recherche la date
    Set Cel = Plage.Find(LaDate, , xlValues, xlWhole)
 
    'si trouvé
    If Not Cel Is Nothing Then
 
        'mémorise l'adresse de la 1ère cellule
        Adr = Cel.Address
 
        'boucle pour récupérer toutes les dates
        'et stocke les valeurs des colonnes A à D
        'dans un tableau
        Do
 
            I = I + 1
 
            ReDim Preserve Tbl(1 To 4, 1 To I)
 
            Tbl(1, I) = Cel
            Tbl(2, I) = Cel.Offset(0, 1)
            Tbl(3, I) = Cel.Offset(0, 2)
            Tbl(4, I) = Cel.Offset(0, 3)
 
            Set Cel = Plage.FindNext(Cel)
 
        Loop While Adr <> Cel.Address
 
    End If
 
    'colle le résultat à partir de la cellule G1
    Range(Cells(1, 7), Cells(UBound(Tbl, 2), 6 + UBound(Tbl, 1))) _
    = Application.WorksheetFunction.Transpose(Tbl())
 
End Sub

Hervé.

[gilou41]

Merci beaucoup Theze, cela fonctionne.Il faut que j'adapte pour que la date soit le résultat du choix dune listbox
Encore merci