Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Jojo973

XLDnaute Occasionnel
Supporter XLD
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 :
VB: 
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.
 

Pièces jointes

  • exemple.xlsx
    10.2 KB · Affichages: 7
Trier par date Trier par votes

AtTheOne

XLDnaute Accro
Supporter XLD
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
 

Pièces jointes

  • exemple AtTheOne.xlsx
    12.6 KB · Affichages: 2
Vote positif 0 Vote négatif

AtTheOne

XLDnaute Accro
Supporter XLD
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
 

Pièces jointes

  • exemple AtTheOne.xlsx
    13 KB · Affichages: 4
Vote positif 0 Vote négatif

AtTheOne

XLDnaute Accro
Supporter XLD
Re,
Jojo973 à dit:
ce n'est pas vraiment ce que j'attends
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif

Jojo973

XLDnaute Occasionnel
Supporter XLD
Voici le code que j'utilise.
VB: 
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 ?
 
Dernière édition:
Vote positif 0 Vote négatif

Jojo973

XLDnaute Occasionnel
Supporter XLD
Bon au final, je suis allé à cela :
VB: 
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.
 
Vote positif 0 Vote négatif

AtTheOne

XLDnaute Accro
Supporter XLD
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
VB: 
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)
VB: 
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"
VB: 
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
VB: 
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
 

Pièces jointes

  • exemple AtTheOne.xlsm
    33.5 KB · Affichages: 2
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
136
sebastien176
S
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
386
Chaton77
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
515
Compte Supprimé 979
C
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
529
laurent950
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
430
florian50470
F
C
  • Résolu(e)
Microsoft 365 Amélioration Macro.
Réponses
7
Affichages
515
crazy
C
S
  • Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
3
Affichages
588
salma_hayek
S
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
613
Mody200
M
M
  • Question
XL 2019 Copier des lignes les unes a la suite des autres dans une autre feuille sous conditions et seulement certaines colonnes
Réponses
7
Affichages
610
MGH
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…