Je crois qu'il manque pas mal d'informations, comme par exemple ledit code.
[/edit]
Private Sub CommandButton1_Click()
' Variable
Dim PL As Range
Dim dlg As Long
' ListeBox1
Dim TV As Variant
' ListeBox2
Dim lignes As Variant
Dim colonnes As Variant
' Base de Colonne A à D
dlg = Range("A1000").End(xlUp).Row
Set PL = Sheets("data").Range("A2:D" & dlg)
' ListeBox1 = Colonne A
TV = Application.Index(PL.Value, , 1)
Worksheets("Resultat").ListBox1.List = TV
TV = Empty
' A créer pour exemple (Avec 2 colonnes "3 = C et 4 = D")
' ListeBox2 = Colonne C et D
lignes = Evaluate("row(" & PL.Row & ":" & PL.Rows.Count & ")") ' Ligne 2 = PL.Row et Derniere Lignes "20" = PL.Rows.Count (19)
colonnes = Array(3, 4) ' Colonne 3 = C et 4 = D
Worksheets("Resultat").ListBox2.ColumnCount = UBound(colonnes) + 1 ' Nombres de colonne de la Listebox2
TV = Application.Index(PL.Value, lignes, colonnes) ' Récupération des données
Worksheets("Resultat").ListBox2.List = TV ' Transfert dans la listeBox
lignes = Empty: colonnes = Empty: TV = Empty
End SubSalut Jean Marie
Private Sub CommandButton1_Click()
Dim n&, o As Object, tablo, liste(), i&
n = Application.CountIf([A:A], Date)
Set o = Sheets("resultat").OLEObjects("ListBox1").Object
o.Clear
If n = 0 Then Exit Sub
tablo = [A1].CurrentRegion.Resize(, 4)
ReDim liste(1 To n, 1 To 2)
n = 0
For i = 2 To UBound(tablo)
If tablo(i, 1) = Date Then n = n + 1: liste(n, 1) = tablo(i, 3): liste(n, 2) = tablo(i, 4)
Next
'---restitution---
o.List = liste
Sheets("resultat").Activate 'facultatif
End SubPrivate Sub CommandButton1_Click()
' Variable
Dim PL As Range
Dim dlg As Long
Dim calend As Date
Dim i As Long
' Date Aujourd'hui
calend = Format(Now, "dd/mm/yyyy")
' ListeBox1
Dim TV() As Variant
ReDim TV(1 To 1)
' ListeBox2
Dim lignes() As Variant
ReDim lignes(1 To 1, 1 To 1)
Dim colonnes As Variant
' Base de Colonne A à D
dlg = Range("A1000").End(xlUp).Row
Set PL = Sheets("data").Range("A2:D" & dlg)
' Boucle avec condition pour la date du jour avec la variable Range : Application.Index(PL.Value, , 1)
' Qui contient la colonne A toutes les lignes
' Date du Jour = calend
' Stock dans une variable tableau ci-dessous.
' lignes = Tableau 2 D soit 1 lignes et Plusieurs colonnes / ---->> lignes(1 To 1, 1 To 1)
For i = LBound(Application.Index(PL.Value, , 1)) To UBound(Application.Index(PL.Value, , 1))
' Condition si c'est la date du jour enregistrer dans le tableau 2 D
If Application.Index(PL.Value, , 1)(i, 1) = calend Then
' Valeurs
TV(UBound(TV)) = Application.Index(PL.Value, , 1)(i, 1)
ReDim Preserve TV(1 To UBound(TV) + 1)
' Ligne
lignes(1, UBound(lignes, 2)) = i
ReDim Preserve lignes(1 To 1, 1 To UBound(lignes, 2) + 1)
End If
Next i
' lignes = suprime la derniére colonnes vide.
ReDim Preserve lignes(1 To 1, 1 To UBound(lignes, 2) - 1)
' 'lignes = Transpose le Tableau 2 D en Plusieurs x lignes sur 1 seule colonne
lignes = Application.Transpose(lignes)
' Resultat pour ListeBox1 en relation avec les dates d'aujourd'hui
' ListeBox1 = Colonne A
Worksheets("Resultat").ListBox1.List = TV
' Résultat pour la ListeBox2 avec les dates d'aujourd'hui pour les 2 colonnes "3 = C et 4 = D"
' Pour les dates d'aujourd'hui
'
' A créer pour exemple = La ListeBox2
' ListeBox2 = Colonne C et D
' PM ce tableau lignes a était transposé avec Application.Transpose(Ici le tableau = Lignes) ' Les Lignes des dates d'aujourd'hui
colonnes = Array(3, 4) ' les Colonne 3 = C et 4 = D
Worksheets("Resultat").ListBox2.ColumnCount = UBound(colonnes) + 1 ' Nombres de colonne de la Listebox2 soit 2 colonnes (C et D)
TV = Application.Index(PL.Value, lignes, colonnes) ' Récupération des données dans la variable tableau TV
Worksheets("Resultat").ListBox2.List = TV ' Transfert du tableay TV dans la listeBox3
' Decharge les variables
Set PL = Nothing: dlg = Empty: calend = Empty
i = Empty
Erase lignes: colonnes = Empty: Erase TV
End SubPrivate Sub CommandButton1_Click()
Dim n&, o As OLEObject, tablo, liste(), i&
n = Application.CountIf([A:A], Date)
Set o = Sheets("resultat").OLEObjects("ListBox1")
o.Object.Clear
If n = 0 Then Exit Sub
tablo = [A1].CurrentRegion.Resize(, 4)
ReDim liste(1 To n, 1 To 2)
n = 0
For i = 2 To UBound(tablo)
If tablo(i, 1) = Date Then n = n + 1: liste(n, 1) = tablo(i, 3): liste(n, 2) = tablo(i, 4)
Next
'---restitution---
o.Object.List = liste
o.Parent.Activate 'facultatif
End Sub
Si tu suivais bien mes interventions tu verrais que la plupart du temps je donne des solutions optimisées pour être les plus simples possibles.Bon sans polémiquer , j'en reviens pas ? Gérard m'a fait un truc SIMPLE ..!
Oui justement .. je les suis depuis belle lurette et je sais que 9 fois sur dix je pige pas ??? code trop complexe non compréhensible pour des néophytes
excel-downloads.com
Private Sub CommandButton1_Click()
' Variable
dlg = Range("A1000").End(xlUp).Row
Set PL = Sheets("data").Range("A2:D" & dlg)
Tbl1 = PL.Value
clé = Format(Now, "dd/mm/yyyy"): colclé = 1: colRécup = Array(3, 4)
Tbl = SupArrayCléCol(Tbl1, clé, colclé, colRécup)
Worksheets("Resultat").ListBox1.ColumnCount = UBound(Tbl, 2) + 1
Worksheets("Resultat").ListBox1.List = Tbl
End Sub
' ********************************************************************************* '
Function SupArrayCléCol(Tbl, clé, colclé, colRécup)
n = 0
For i = LBound(Tbl, 1) To UBound(Tbl, 1)
If Tbl(i, colclé) = CDate((clé)) Then n = n + 1
Next i
j = 0
Dim Tbl2(): ReDim Tbl2(1 To n, LBound(colRécup) To UBound(colRécup))
For i = LBound(Tbl, 1) To UBound(Tbl, 1)
If Tbl(i, colclé) = CDate(clé) Then
j = j + 1
For k = LBound(colRécup) To UBound(colRécup): Tbl2(j, k) = Tbl(i, colRécup(k)): Next k
End If
Next i
SupArrayCléCol = Tbl2
End FunctionLes choses simples peuvent être difficiles à comprendre si l'on a l'esprit encombré par des a priori compliqués.
