Discussion :

[gilou41]

Bonjour, Suite à un premier Help, Theze m'a donné le code ci-dessous. Je n'arrive pas à l'adapter à mon fichier.
Je souhaiterais que la valeur de LaDate soit celle que je selectionne dans une listbox.
De plus quand les données se copient, il faudrait qu'une nouvelle recherche se copie à la suite de la première (actuellement, la seconde écrase la première).
Merci d'avance

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
Sub test()
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 = #8/31/2011#
 
    'plage où s'effectue la recherche de date (colonne A)
    Set Plage = Range([T1], [T65536].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 6, 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)
            Tbl(5, I) = Cel.Offset(0, 4)
            Tbl(6, I) = Cel.Offset(0, 5)
            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

[Theze]

Bonsoir gilou41,

Dans mon exemple, la ListBox est une contrôle ActiveX incorporé dans Feuil1 (nom de la feuille dans le VBE et non celui d'Excel), Les valeurs sont collées les unes à la suite des autres dans la colonne G, adapte :

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
 
Sub Test()
 
    Dim Tbl()
    Dim Plage As Range
    Dim Cel As Range
    Dim LaDate As Date
    Dim Adr As String
    Dim I As Integer
    Dim L As Long
 
    'la date cherchée est celle choisie dans la ListBox
    '(Contrôle ActiveX située dans la Feuil1)
    'Nom dans le VBE = Feuil1
    With Feuil1.ListBox1
 
        'si pas de choix, message et fin
        If .ListIndex = -1 Then
 
            MsgBox "Vous devez faire un choix !"
            Exit Sub
 
        End If
 
        LaDate = .List(.ListIndex)
 
    End With
 
    'plage où s'effectue la recherche de date (colonne A)
    Set Plage = Range([T1], [T65536].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 6, 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)
            Tbl(5, I) = Cel.Offset(0, 4)
            Tbl(6, I) = Cel.Offset(0, 5)
 
            Set Cel = Plage.FindNext(Cel)
 
        Loop While Adr <> Cel.Address
 
    End If
 
    'colle le résultat à partir de la première cellule vide en colonne G
    If [G65536].End(xlUp).Row = 1 Then L = 1 Else L = [G65536].End(xlUp).Row + 1
    Range(Cells(L, 7), Cells(L + UBound(Tbl, 2) - 1, 6 + UBound(Tbl, 1))) _
    = Application.WorksheetFunction.Transpose(Tbl())
 
End Sub

Hervé.