Trier 2 "bouts" de colonne par date

Trier 2 "bouts" de colonne par date - VB/VBA/VBS - Programmation

Marsh Posté le 11-05-2009 à 10:56:44    

Bonjour,  
 
J'ai un petit problème de tri de colonne.  
J'ai deux colonnes comprenant des dates et j'aurais voulu les ranger en ordre décroissant.  
J'ai donc fait un code pour trier une colonne mais je n'arrive pas à l'adapter afin qu'il puise les données dans une autre colonne que la B lorsqu'il rencontre une cellule vide.  
Je vois met un print écrant du tableau à trier ainsi que l'ébauche de code que j'ai réalisé.
 

Code :
  1. Columns("B:B" ).Select
  2.         ActiveWorkbook.Worksheets("Fiche produit type" ).Sort.SortFields.Clear
  3.         ActiveWorkbook.Worksheets("Fiche produit type" ).Sort.SortFields.Add Key:=Range("B1" ), _
  4.             SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  5.         nbLigne = Range("B65536" ).End(xlUp).Row
  6.         With ActiveWorkbook.Worksheets("Fiche produit type" ).Sort
  7.             .SetRange Range("A2:E1" & nbLigne)
  8.             .Header = xlNo
  9.             .MatchCase = False
  10.             .Orientation = xlTopToBottom
  11.             .SortMethod = xlPinYin
  12.             .Apply
  13.         End With


 
http://download.yousendit.com/U0d3b244Nnk4NVYzZUE9PQ

Reply

Marsh Posté le 11-05-2009 à 10:56:44   

Reply

Marsh Posté le 11-05-2009 à 17:09:52    

J'ai avancé un peu mais mon code bloque (à partir de la ligne 27) et je n'arrive pas à comprendre pourquoi.  
Je suis passée par une colonne intermédiaire réprennant les données des 2 colonnes à trier pour faire au plus simple.  
 

Code :
  1. Dim Ligne As Integer
  2. Dim produit As String
  4. produit = Sheets("reception_donnees" ).Range("D" & cellule).Value
  6.     If Range("B65536" ).End(xlUp).Row > Range("C65536" ).End(xlUp).Row Then
  7.     Ligne = Range("B65536" ).End(xlUp).Row
  8.     Else:
  9.     Ligne = Range("E65536" ).End(xlUp).Row
  10.     End If
  12.     For i = 1 To nbLigne
  13.     If Cells(i, 2) <> "" Then
  14.     Cells(i, 12) = Cells(i, 2)
  15.     ElseIf Cells(i, 5) <> "" Then
  16.     Cells(i, 12) = Cells(i, 5)
  17.     End If
  18.     Next i
  20.     Columns("A:L" ).Select
  21.     Selection.AutoFilter
  23.         ActiveWorkbook.Worksheets(produit).Sort.SortFields.Clear
  25. 'la macro s'exécute jusqu'ici
  27.     ActiveWorkbook.Worksheets(produit).AutoFilter.Sort.SortFields.Add Key:=Range _
  28.         ("L1:L20" ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
  29.         xlSortNormal
  30.     With ActiveWorkbook.Worksheets(produit).AutoFilter.Sort
  31.         .Header = xlYes
  32.         .MatchCase = False
  33.         .Orientation = xlTopToBottom
  34.         .SortMethod = xlPinYin
  35.         .Apply
  36.     End With


Message édité par Fouinette85 le 11-05-2009 à 17:10:24
Reply

Marsh Posté le 11-05-2009 à 17:35:53    

Produit est une variable qui traduit mon numéro de produit qui est également mon nom de feuille. Je ne pense pas que ce soit celà qui pose problème car je fonctionnement comme ça dans de nombreuses autres macros sans soucis et que la ligne précédente :  
 

Code :
  1. ActiveWorkbook.Worksheets(produit).Sort.SortFields.Clear


 
fonctionne normalement et me renvoi un numéro de produit correpondant à une feuille belle et bien créer.  
 
Merci du coup de main quand même

Reply

Marsh Posté le 11-05-2009 à 17:37:44    

Ok, je me suis enduit d'erreur
il faudrait un fichier même parcellaire

Reply

Marsh Posté le 11-05-2009 à 17:46:39    

Il est compliqué de fournir un fichier "parcellaire" car comme tu peux le constater mes macros font référence à pas mal de feuilles du fichier. Je t'envoi donc la version intégrale en espérent que le fichier ne t'effraira pas trop ^^
 
Je t'es affiché une feuille produit (n°758884) afin que tu vois ce que je devrais obtenir après l'application de ce bout de macro que tu peux trouver dans le module "fonction" => "Public Sub parcoursDonnees()"
 
http://www.yousendit.com/download/ [...] YUIzZUE9PQ


Message édité par Fouinette85 le 11-05-2009 à 17:47:14
Reply

Marsh Posté le 11-05-2009 à 18:36:43    

Salut, voir fichier modifié sur http://cjoint.com/?flsI5RwEiK
 


        For i = 1 To nbLigne
 


 remplacé par
 


        For i = 2 To Ligne
 


 
 


        ActiveWorkbook.Worksheets(produit).Sort.SortFields.Clear
        ActiveWorkbook.Worksheets(produit).AutoFilter.Sort.SortFields.Add Key:=Range _
                                                                               ("L1:L20" ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                                                                          xlSortNormal
        With ActiveWorkbook.Worksheets(produit).AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 


 remplacé par
 


        ActiveWorkbook.Worksheets(produit).Sort.SortFields.Clear
        ActiveWorkbook.Worksheets(produit).Sort.SortFields.Add Key:=Range("L2:L20" ) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         
        With ActiveWorkbook.Worksheets(produit).Sort
            .SetRange Range("A2:L20" )
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With


 
Mais l'erreur principale est dans  

For i = 1 To nbLigne


qui empiète sur le header avec en plus NbLigne qui reste à 0
 
Qqs utilitaires
SmartIndenter sur http://www.oaltd.co.uk/Indenter/Default.htm
MZ Tools for VBA sur  http://www.mztools.com/v3/mztools3.aspx  
 
Utiliser systématiquement Option Explicit
Te renseigner sur CodeName par exemple sur http://www.ozgrid.com/VBA/excel-vba-sheet-names.htm


Message édité par kiki29 le 11-05-2009 à 22:13:26
Reply

Marsh Posté le 12-05-2009 à 09:33:46    

Merci du coup de main je testerai tes utilitaires chez moi car au boulot je ne peux pas les installer. Mon problème n'est toujours pas résolu mais je continue de me pencher sur le sujet.

Reply

Marsh Posté le 12-05-2009 à 21:01:26    

Salut, qqs modifs : notamment j'ai remplacé ">" par ">=" ainsi que 65536 par Rows.Count et insertion de "Ligne" dans les procédures de tri


        'Tri par date de facturation ou proposition
        If Range("B" & Rows.Count).End(xlUp).Row >= Range("C" & Rows.Count).End(xlUp).Row Then
            Ligne = Range("B" & Rows.Count).End(xlUp).Row
        Else:
            Ligne = Range("E" & Rows.Count).End(xlUp).Row
        End If
 
        For i = 2 To Ligne
            If Cells(i, 2) <> "" Then
                Cells(i, 12) = Cells(i, 2)
            ElseIf Cells(i, 5) <> "" Then
                Cells(i, 12) = Cells(i, 5)
            End If
        Next i
 
        ActiveWorkbook.Worksheets(produit).Sort.SortFields.Clear
        ActiveWorkbook.Worksheets(produit).Sort.SortFields.Add Key:=Range("L2:L" & Ligne), _
                                                               SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets(produit).Sort
            .SetRange Range("A2:L" & Ligne)
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
        Columns("A:L" ).Select
        Selection.AutoFilter


Message édité par kiki29 le 12-05-2009 à 21:24:41
Reply

Marsh Posté le 13-05-2009 à 16:14:25    

Merci bien j'avais réussi à gérer le prob avec la fonction si mais j'utilise tes modifs de  Rows.Count à la place de  65536.  
Merci du coup de main

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed