Microsoft 365 Trier des données et les afficher sur une autre feuille

[Jojo973]

Bonjour,

Voici mon problème :
J'ai une feuille où sont stockées des données par dates et pour une même date il peut y avoir plusieurs saisies.
Je dois les récupérer (data) et les afficher dans une autre feuille(aff_data_tri).

J'ai essayé avec le code suivant et il fonctionne pour ligne :

datestrg = "25/02/2024"

If Not searchdate(datestrg) Is Nothing Then
          
                u = searchdate(datestrg).Row
                v = 0
              
        ligne_vide = sheets("aff_data_tri").Range("A65536").End(xlUp).Row + 1

                u2 = Cells(ligne_vide, 1).Row           
                For i 1 to 2
                Sheets("aff_data_tri").Cells(u2, v + i).value = Sheets("data").Cells(u, v + i).value
                Next i

'fonction

Function searchdate(datestrg) As Range
  
    Dim rng
       
    Set rng = Sheets("Data").Range("A2:B6000")
    Set searchdate = rng.Find(What:=datestrg, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
     
End Function

Je n'arrive pas à boucler toutes les dates, j'ai essayé for Each Cell mais cela me multiplie juste les mêmes données.

Merci pour votre aide.

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @Jojo973
Peut-être avec la fonction TRIER() disponible dans EXCEL365 ...
(Source = le tableau structuré des données source)
la fonction matricielle dynamique en cellule A2 de ta feuille cible : =TRIER(Source;1;1)
renvoie ton tableau trié par date directement
voir PJ
A bientôt

 

[AtTheOne]

re
maintenant si tu dois coupler cela avec un filtre sur les dates, tu as la fonction filtre :
=FILTRE(Source;Source[Date]=F2;"pas de date")
avec la date à filtrer en F2
et si tu as des heures en plus des dates tu peux filtrer et trier :
=TRIER(FILTRE(Source;ENT(Source[Date])=F2;"Pas de date");1;1)

voir PJ
A bientôt

 

[Jojo973]

Bonjour,
ce n'est pas vraiment ce que j'attends mais merci tout de même.

 

[AtTheOne]

Re,

ce n'est pas vraiment ce que j'attends

Peux-tu repréciser ton besoin :
Tu as une liste avec des dates ( parfois redondantes), tu dois récupérer toutes les données par date.
Veux-tu boucler sur les dates de ta liste, ou sur une autre liste de date ? Est-ce que la feuille cible est dans le même classeur que la liste source ?
Je peux t'aider pour le faire en VBA, mais il me semble que les fonctions matricielles dynamiques disponibles dans Excel 365 le font très bien...
Me trompe-je ?
A bientôt

 

[Jojo973]

Tout doit être codé, dans le fichier original, il faut cliquer sur des cellules contenant des dates et afficher dans une listbox, tous les résultats pour cette date présentent dans la feuille data

 

[Jojo973]

Voici le code que j'utilise.

Sub searchaploc()
   
  
Sub searchaploc()
    
    Dim searchdate As Range
    Dim ligne_vide_dataff As Variant
    Dim datestrg As String
    Dim u, v, u2, v2
    Dim i      As Integer
    
    With Sheets("Data2").Range("B2:B6000")
        Sheets("AP locales-autres plans").Cells(503, 1).NumberFormat = "dd/mm/yyyy"
        datestrg = Sheets("AP locales-autres plans").Cells(503, 1).value
        
        
        
        Set searchdate = .Find(What:=datestrg, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
        
        If Not searchdate Is Nothing Then
            
            u = searchdate.Row
            
            ligne_vide_dataff = Sheets("Dataff").Range("A65536").End(xlUp).Row + 1
            
            u2 = Sheets("Dataff").Cells(ligne_vide_dataff, 1).Row
            
            Do
                
                Sheets("Dataff").Cells(u2, 1).value = Sheets("data2").Cells(u, 1).value
                Sheets("Dataff").Cells(u2, 2).value = Sheets("data2").Cells(u, 2).value
                Sheets("Dataff").Cells(u2, 3).value = Sheets("data2").Cells(u, 3).value
                Sheets("Dataff").Cells(u2, 4).value = Sheets("data2").Cells(u, 4).value
                Sheets("Dataff").Cells(u2, 5).value = Sheets("data2").Cells(u, 7).value
                
                Set searchdate = .FindNext(searchdate)
                
            Loop While Not searchdate Is Nothing
            
        End If
    End With
    
End Sub
   
End Sub

Mais le problème est que la boucle est infinie alors que la même date est présente 4 fois dans la colonne.

Auriez vous une idée ?

 

[job75]

Bonjour le forum,

afficher dans une listbox

Ca vient comme un cheveu sur la soupe.

A+

 

[Jojo973]

Bon au final, je suis allé à cela :

Sub searchaploc()
    
    Dim searchdate As Range
    Dim ligne_vide_dataff
    Dim datestrg, valeur_cherche As String
    Dim u, u2  As Long
    
    datestrg = Sheets("AP locales-autres plans").Cells(503, 1).value 'valeur à chercher
    last_cel = Sheets("Data2").Range("B" & Rows.Count).End(xlUp).Row 'dernière ligne de la plage de recherche
    
    For i = 2 To last_cel
        
        valeur_cherche = Sheets("Data2").Cells(i, 2).value
        
        If valeur_cherche = datestrg Then
            u = i
            ligne_vide_dataff = Sheets("Dataff").Range("A65536").End(xlUp).Row + 1
            u2 = Sheets("Dataff").Cells(ligne_vide_dataff, 1).Row
            
            Sheets("Dataff").Cells(u2, 1).value = Sheets("data2").Cells(u, 1).value
            Sheets("Dataff").Cells(u2, 2).value = Sheets("data2").Cells(u, 2).value
            Sheets("Dataff").Cells(u2, 3).value = Sheets("data2").Cells(u, 3).value
            Sheets("Dataff").Cells(u2, 4).value = Sheets("data2").Cells(u, 4).value
            Sheets("Dataff").Cells(u2, 5).value = Sheets("data2").Cells(u, 7).value
        End If
    Next i
    
End Sub

A mon avis largement améliorable mais ça fonctionne très bien.

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @Jojo973
A la vue de tes 3 derniers posts, je comprends mieux ton besoin.
Heureux de voir que tu as trouvé une solution par tes propres moyens.

J'ai transformé ta liste en "data2" en tableau structuré (nommé "Source") bien plus facile à gérer.

Je te propose une fonction qui peut être utilisée de différentes façons, avec 3 exemples :

• Affichage d'un message sur clic droit dans le tableau de la feuille "data2".
• Report dans la feuille "Dataff" (date lue en A503 de la feuille "AP locales-autres plans")
• Affichage dans une listbox d'un formulaire (date lue en A503 de la feuille "AP locales-autres plans")

Code de la fonction

Function Collecter(Source As ListObject, ColDate As String, maDate As Long) As Variant
   
     Dim res(), cmpt As Long, tablo, n As Long, i As Long, j%
   
     'nombre de lignes correspondant à la date
     cmpt = Evaluate("COUNTIF(" & Source.Name & "[" & ColDate & "]," & CLng(maDate) & ")")
   
     'extraction des lignes
     If cmpt > 0 Then
          tablo = Evaluate(Source.Name)                'les données du ListObject
          ReDim res(1 To cmpt, 1 To UBound(tablo, 2))  'tableau pour les lignes extraites
         
          n = 0
          For i = 1 To UBound(tablo)
               If tablo(i, 1) = maDate Then
                    n = n + 1: For j = 1 To UBound(tablo, 2): res(n, j) = tablo(i, j): Next j
               End If
          Next
          Collecter = res
     End If

End Function

Code de la feuille "data2" (sur clic droit)

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   
     Dim maDatelng As Long
     If Target.CountLarge > 1 Or Intersect(Target, Me.[Source]) Is Nothing Then Exit Sub
   
     Cancel = True
     maDatelng = Intersect(Target.EntireRow, Me.[Source[Date]]).Value
     Tableau = Collecter(Me.[Source].ListObject, "Date", maDatelng)
     msg = "liste collectée"
     For i = 1 To UBound(Tableau, 1)
          txt = ""
          For j = 1 To UBound(Tableau, 2)
               txt = txt & Chr(9) & Tableau(i, j)
          Next j
          msg = msg & Chr(10) & txt
     Next i
     MsgBox msg
   
End Sub

Code de la sub de report vers "Dataff"

Sub searchaploc()
    
     Dim maDateLong As Long, TableauSource As ListObject, ColDate$
     Dim Extraction, Derlgn As Long, lgnCible As Long, FCible$, ColCible%
    
     'les données d'entrée
     maDateLong = ['AP locales-autres plans'!A503]
     Set TableauSource = [Source].ListObject
     ColDate = "Date"
     'la feuille cible
     FCible = "Dataff": ColCible = 1
    
     Extraction = Collecter(TableauSource, ColDate, maDateLong)
     If Not IsEmpty(Extraction) Then
          With ThisWorkbook.Worksheets(FCible)
               Derlgn = .Cells(.Rows.Count, ColCible).End(xlUp).Row
               If Derlgn = 1 And .Cells(1, ColCible) = "" Then Derlgn = 0
               lgnCible = Derlgn + 1
               .Cells(lgnCible, ColCible).Resize(UBound(Extraction, 1), UBound(Extraction, 2)).Value = Extraction
          End With
     End If
    
End Sub

Code pour afficher dans une listbox

Sub DansListBox()

     Dim maDateLong As Long, TableauSource As ListObject, ColDate$
     Dim Extraction, Derlgn As Long, lgnCible As Long
    
     'les données d'entrée
     maDateLong = ['AP locales-autres plans'!A503]
     Set TableauSource = [Source].ListObject
     ColDate = "Date"
    
     Extraction = Collecter(TableauSource, ColDate, maDateLong)
    
     If Not IsEmpty(Extraction) Then
          NbCol = UBound(Extraction, 2)
          With UsF_Affichage
               With .LBx_Extrait
                    .List = Extraction
                    .ColumnCount = UBound(Extraction, 2)
                    .Height = 12.75 * UBound(Extraction, 1)
               End With
                    .Caption = "Extraction au " & Format(maDateLong, "dddd d mmmm yyyy")
                    .Height = 47.25 + .LBx_Extrait.Height
                    .Show
          End With
     End If
    
End Sub

Voir le fichier en pièce jointe
Bon courage et à bientôt

 

[Jojo973]

Ha oui merci, pour le code, fonctionne bien et m'arrange pour la suite.