Discussion :

[BERRACHED SAID]

bonjour le forum et bonne journée

j'ai adapter un code d'extraction de données d'une feuille de calcul entre deux dates via deux textbox et affiché le résultat dans une listbox mais malheureusement je n'arrive pas a alimenter la listbox j'ai essayé tout les propriétés (Additem,List,Rowsource) et ça coince justement a ce niveau voici le code que j'ai adapter :

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
Private Sub cbtOK_Click()
Dim tableau()
Dim i As Integer
Dim c As Variant
i = 0
If Me.tbxStart <> "" And Me.tbxEnd <> "" Then
'** ajouter des vérifications sur la "validité" des dates renseignées serait utile
    With Sheets("TPor")
        For Each c In .Range("A2:A" & .Range("A65000").End(xlUp).Row)
            If c.Value >= CDate(tbxStart) And c.Value <= CDate(tbxEnd) Then
                ReDim Preserve tableau(i + 1)
                tableau(i) = .Range("a" & c.Row & ":" & "I" & c.Row).Value
                i = i + 1
            End If
        Next c
    End With
    With Me.ListBox1
       ListBox1.Clear
        For i = 0 To UBound(tableau)
           ListBox1.AddItem tableau(i)
        Next i
    End With
End If
Me.Hide
End Sub
 
Private Sub tbxEnd_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  If Not IsDate(tbxEnd) Then MsgBox "Veuillez entrer Une Date Svp": tbxEnd = "": Exit Sub
   Fin = CDate(tbxEnd)
End Sub
 
Private Sub tbxStart_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   If Not IsDate(tbxStart) Then MsgBox "Veuillez entrer Une Date Svp": tbxStart = "": Exit Sub
    Start = CDate(tbxStart)
 End Sub

merci d'avance pour vos réponses et bonne journée mesdames et messieurs

[BERRACHED SAID]

Bonjour le forum et bonne journée


j'ai finalement pu pouvoir alimenter ma listbox mais l’exécution et trop lente si quelqu'un a une idée voici le code :

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
Private Sub cbtOK_Click()
    Dim wsBD As Worksheet
    Dim derLig As Long
    Dim Lig As Long
    Dim Plage As Range
    Dim CritRente As String
    Dim CritDateDeb As String
    Dim CritDateFin As String
    Dim LigList As Long
    Dim Cumul As Currency
    Dim nc As Integer, s As String
 
    Set wsBD = Worksheets("TPor")
    ' Dernière ligne dans la feuille BD
    derLig = wsBD.Range("A" & Cells.Rows.Count).End(xlUp).Row
    If derLig < 2 Then Exit Sub
 
    ' Définition de la plage en colonne A
    Set Plage = wsBD.Range("A2:A" & derLig)
 
        ' Date Début
    CritDateDeb = tbxStart.Value
    If tbxStart.Value = "" Or Not IsDate(tbxStart.Value) Then
        CritDateDeb = Format(Application.WorksheetFunction.Min(Plage), "dd/mm/yyyy")
    End If
        ' Date Fin
    CritDateFin = tbxEnd.Value
    If tbxEnd.Value = "" Or Not IsDate(tbxEnd.Value) Then
        CritDateFin = Format(Application.WorksheetFunction.Max(Plage), "dd/mm/yyyy")
    End If
    CritDateFin = DateAdd("d", 1, CritDateFin)
 
    LigList = 1
 
    ' Vider la listview
    ListBox1.Clear
 
    ' Boucle sur toutes les lignes
    For Lig = 2 To derLig
        ' Rechercher par rapport aux critères
        If CDate(wsBD.Range("A" & Lig).Value) >= CDate(CritDateDeb) And _
           CDate(wsBD.Range("A" & Lig).Value) < CDate(CritDateFin) Then
 
            ' Remplir la première colonne
            With ListBox1
            .AddItem wsBD.Range("A" & Lig).Value
            'Remplissage colonnes 2 à 5
            .List(.ListCount - 1, 1) = wsBD.Range("B" & Lig).Value
            .List(.ListCount - 1, 2) = wsBD.Range("C" & Lig).Value
            .List(.ListCount - 1, 3) = wsBD.Range("D" & Lig).Value
            .List(.ListCount - 1, 4) = wsBD.Range("E" & Lig).Value
            .List(.ListCount - 1, 5) = wsBD.Range("F" & Lig).Value
            .List(.ListCount - 1, 6) = wsBD.Range("G" & Lig).Value
            .List(.ListCount - 1, 7) = wsBD.Range("H" & Lig).Value
            .List(.ListCount - 1, 8) = wsBD.Range("I" & Lig).Value
            .List(.ListCount - 1, 9) = Format(wsBD.Range("J" & Lig), "#,##0.00")
           End With
             LigList = LigList + 1
        End If
    Next Lig
  CALCL
End Sub

merci d'avance

[Stef999]

Bonjour,

Si le nombre de ligne est très important on peut utiliser les fonctions natives d'excel plutôt que des boucles en VBA ...

Exemple :
Ce qui permet d'extraire des données qui répondent à des critères c'est le filtre avancé.
En programmant ce filtre en VBA (avec extraction vers un autre emplacement) ... puis en affectant la plage résultante au RowSource du ListBox le gain de temps peut être significatif ... je parle là de listes de 10000 lignes ou plus ...

Une autre piste c'est de travailler avec des tableaux en vba (il y a des tutos sur le site).

Il y a encore d'autre solutions j'imagine ...

Stéphane

[BERRACHED SAID]

merci stef

c'est exactement ça je vais voir du coté des tutos histoire de dénicher quelque chose.

merci et bonne journée