Tri sur 2 critères

[C@thy]

Bonjour le forum,

tiens, not' site préféré a un nouveau look aujourd'hui!!!

Bien qu'un fil soit en cours sur le sujet, Ici :
http://www.excel-downloads.com/forum/154294-vba-tri-par-chapitre-new-post.html

je pense (enfin j'espère) que l'on peut trouver une solution aussi sur ce forum, car il s'agit d'un tri selon 2 critères, l'un ascendant, l'autre décroissant (miam!!!), et surtout, Zon a la gentillesse de m'aider, mais il est un peu seul sur le coup,
et comme, c'est bien connu, on est plus intelligents à plusieurs qu'à un tout seul, peut-être que sur le forum Excel on peut aussi avoir des idées à ce sujet... plutôt ardu... (sinon c'est pas drôle, Lol!)

Merci à tous ceux qui auraient des idées.

Je peux en soumettre une, qui vaut ce qu'elle vaut, réenregistrer les fichiers avec pour nom le thème, suivi du nombre de minutes restant dans la journée jusqu'à minuit suivi du titre de la news
ou, comme le suggère Zon, créer des répertoirez temporaires, un par thème,
ou... que sais-je???

Je vais peut-être dire une bêtise (ça ne sera pas la première fois!!!), mais est-il possible de faire une table à double entrée dans ce cas???

Merci à vous si vous entrevoyez une façon de faire ce tri selon 2 critères.

Bises à tout le monde

C@thy

 

[kjin]

Re : Tri sur 2 critères

Bonjour,
J'aurais bien voulu t'aider, mais comme à mon habitude, je n'ai rien compris !
Je ne vois absolument pas le résultat que tu souhaites obtenir (arborescence dans le doc word)
A+
kjin

 

[C@thy]

Re : Tri sur 2 critères

Bonjour kjin,

dans le document le sommaire est trié par thème (c'est fait), ce qu'il nous manque c'est que sous chaque thème les documents doivent apparaître triés par ordre décroissant de leur date, le + récent en 1er...

Biz

C@thy

 

[C@thy]

Re : Tri sur 2 critères

Bonjour le forum,
plus j'y repense et plus je me dis que Zon a raiZon
peut-on créer des répertoires par thème,
y copier les fichiers du thème, trier a l'intérieur par date de derniere modif décroissante et ensuite supprimer les répertoires?
Ca vous semble difficile a faire??
Meme si c'est une usine a gaz, il est important que ce tri fonctionne.
Le faire dans le document lui-même je sais pas faire
Si vous avez des idées... Réalisables en Vba...
Bibises & bon ouik

C@thy

 

[Guest]

Re : Tri sur 2 critères

Bonjour C@thy, Kjin et autre lecteur

tous les fichiers news dans un même répertoire (Nommé 'News' dans la macro)

La macro(dans document WORD) ci-dessous utilise excel pour trier(il sait si bien le faire) et en fin de macros tu obtiens une variable tableau nommée Titres à deux dimensions trié sur la date (ascendante et les noms). Testé sur Excel 2002 (XL.Quit plante chez pour quitter excel je le ferme manuellement)

Option Explicit
Dim Titres()
Dim chemin As String
Const xlAscending = 1
Const xlDescending = 2
Const xlGuess = 0
Const xlNo = 2
Sub TriDays()
    Dim XL As Object, wkb As Object
    chemin = ThisDocument.Path & "\News"
    ListeDay
    Set XL = CreateObject("Excel.Application")
    XL.Visible = True
    Set wkb = XL.Workbooks.Add()
    With wkb
        With .Sheets(1)
            .Range("A1").Resize(UBound(Titres, 1), 2) = Titres
            With .Range("A1").CurrentRegion
                .Sort Key1:=.Range("B1"), Order1:=xlAscending, Key2:=.Range("A1"), Order2:=xlAscending, Header:=xlGuess
                ReDim Titres(1 To .Rows.Count, 2)
                Titres = .Value
            End With
        End With
    End With
    wkb.Saved = True
    wkb.Close
    XL.Application.Quit
    Set wkb = Nothing
    Set XL = Nothing
End Sub
Sub ListeDay()
    Dim i As Integer
    Dim Dossier As Object, Fichier As Object
    ChangeFileOpenDirectory chemin
    i = 0
    Set Dossier = CreateObject("Scripting.FileSystemObject").getfolder(chemin)
    ReDim Titres(1 To Dossier.Files.Count, 1 To 2)
    For Each Fichier In Dossier.Files
        If Right(Fichier.Name, 4) = ".doc" And LCase(Left(Fichier.Name, 9)) <> "prompteur" Then  ' liste les fichier DOC seulement
            i = i + 1
            Titres(i, 1) = Fichier.Name
            Titres(i, 2) = Fichier.DateLastModified
        End If
    Next
End Sub

A+

 

[C@thy]

Re : Tri sur 2 critères

Coucou Hasco, contente de te voir,
Merci bcp pour ton code. Je suis sur mon tél, & chez des amis en We, alors je ne pourrai tester que lundi.
Oui une table a double entrée c'est ce que je cherchais a faire. Tous les fichiers ne sont pas dans le meme repertoire, certains sont sous lundi, d'autres mardi etc...
Est-ce que ca va marcher?? .

Bises
C@thy

 

[Guest]

Re : Tri sur 2 critères

Re,
Moi aussi être content croiser toi

Pas entièrement satisfait en terme de performance par ma dernière solution, j'ai fini par trouver un alogrythme de tri de tableau à deux dimensions (d'un certain Andrew Backer)

J'ai testé sous excel avec tes fichiers word et leur date de création (la date de modif était la même pour tous, celle du dézippage de ton fichier) et cela semble fonctionner correctement.

A la sortie de la sub ListeDay tu auras la variable Tableau 'Titres' à deux dimensions, triée sur la date de modification.

A toi de voir comment l'intégrer dans ta Macro, cela ne devrait pas être trop difficile. Perso, je ne connais pas aussi bien VBA word qu'excel, c'est pourquoi je n'y ai pas touché.

[COLOR=blue]Dim[/COLOR] Titres()
[COLOR=blue]Dim[/COLOR] chemin [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR]
[COLOR=blue]Sub[/COLOR] ListeDay()
    [COLOR=blue]Dim[/COLOR] i [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR]
    [COLOR=blue]Dim[/COLOR] Dossier [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR], Fichier [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR]
    [COLOR=green]'La ligne ci-dessous est à décommenter pour WORD[/COLOR]
    ChangeFileOpenDirectory chemin
    i = 0
    [COLOR=blue]Set[/COLOR] Dossier = CreateObject([I]"Scripting.FileSystemObject"[/I]).getfolder(chemin)
    [COLOR=blue]ReDim[/COLOR] Titres(1 To Dossier.Files.Count, 1 To 2)
    [COLOR=blue]For[/COLOR] [COLOR=blue]Each[/COLOR] Fichier [COLOR=blue]In[/COLOR] Dossier.Files
        [COLOR=blue]If[/COLOR] Right(Fichier.Name, 4) = [I]".doc"[/I] [COLOR=blue]And[/COLOR] LCase(Left(Fichier.Name, 9)) <> [I]"prompteur"[/I] [COLOR=blue]Then[/COLOR]  [COLOR=green]' liste les fichier DOC seulement[/COLOR]
            i = i + 1
            Titres(i, 1) = Fichier.Name
            Titres(i, 2) = Fichier.DateLastModified
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]
    [COLOR=green]'Trier le tableau sur la deuxiè[COLOR=blue]me[/COLOR] colonnes (dates)[/COLOR]
    Array2dSortColumns Titres, 2
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
[COLOR=blue]Sub[/COLOR] Array2dSortColumns([COLOR=blue]ByRef[/COLOR] avValues [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR], lByColumn [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], [COLOR=blue]Optional[/COLOR] bSortDescending [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR] = [COLOR=blue]False[/COLOR])
 [COLOR=green]'By Andrew Baker[/COLOR]
    [COLOR=blue]Dim[/COLOR] alOrder() [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lNumRows [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lThisCol [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lNumRow [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lNumCols [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lStartRow [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lStartCol [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
    [COLOR=blue]Dim[/COLOR] lOffset1 [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lOffset2 [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lThisRow [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lThisRow2 [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lThisPointer [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], lPointer [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
    [COLOR=blue]Dim[/COLOR] avOutput() [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR]
 
 
    lNumRows = [COLOR=blue]UBound[/COLOR](avValues)
    lNumCols = [COLOR=blue]UBound[/COLOR](avValues, 2)
    lStartRow = LBound(avValues)
    lStartCol = LBound(avValues, 2)
 
    [COLOR=blue]ReDim[/COLOR] alOrder(lStartRow To lNumRows)
    [COLOR=blue]For[/COLOR] lNumRow = lStartRow To lNumRows
        alOrder(lNumRow) = lNumRow
    [COLOR=blue]Next[/COLOR]
 
    [COLOR=blue]If[/COLOR] bSortDescending [COLOR=blue]Then[/COLOR]
        lOffset1 = 1
        lOffset2 = 0
    [COLOR=blue]Else[/COLOR]
        lOffset1 = 0
        lOffset2 = 1
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
 
    [COLOR=blue]For[/COLOR] lThisRow = lStartRow To lNumRows - 1
        [COLOR=blue]For[/COLOR] lThisRow2 = lNumRows - 1 To lThisRow [COLOR=blue]Step[/COLOR] -1
            [COLOR=blue]If[/COLOR] (avValues(alOrder(lThisRow2 + lOffset1), lByColumn) > avValues(alOrder(lThisRow2 + lOffset2), lByColumn)) [COLOR=blue]Then[/COLOR]
                [COLOR=green]'Swap the position pointers[/COLOR]
                lThisPointer = alOrder(lThisRow2 + lOffset1)
                alOrder(lThisRow2 + lOffset1) = alOrder(lThisRow2 + lOffset2)
                alOrder(lThisRow2 + lOffset2) = lThisPointer
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
        [COLOR=blue]Next[/COLOR]
    [COLOR=blue]Next[/COLOR]
[COLOR=green]'---Swap all the items[/COLOR]
    [COLOR=blue]ReDim[/COLOR] avOutput(lStartRow To lNumRows, lStartCol To lNumCols)
    [COLOR=blue]For[/COLOR] lThisRow = lStartRow To lNumRows
        lPointer = alOrder(lThisRow)
        [COLOR=blue]For[/COLOR] lThisCol = lStartCol To lNumCols
            avOutput(lThisRow, lThisCol) = avValues(lPointer, lThisCol)
        [COLOR=blue]Next[/COLOR]
    [COLOR=blue]Next[/COLOR]
[COLOR=green]'---Copy back into avValues[/COLOR]
    [COLOR=blue]On[/COLOR] [COLOR=blue]Error[/COLOR] [COLOR=blue]GoTo[/COLOR] ArrayDimmed
    avValues = avOutput
    [COLOR=blue]Exit[/COLOR] [COLOR=blue]Sub[/COLOR]
ArrayDimmed:
    [COLOR=green]'The [COLOR=blue]input[/COLOR] parameter [COLOR=blue]is[/COLOR] [COLOR=blue]not[/COLOR] a [COLOR=blue]variant[/COLOR] array, copy the values [COLOR=blue]in[/COLOR] manually[/COLOR]
    [COLOR=blue]For[/COLOR] lThisRow = lStartRow To lNumRows
        [COLOR=blue]For[/COLOR] lThisCol = lStartCol To lNumCols
            avValues(lThisRow, lThisCol) = avOutput(lThisRow, lThisCol)
        [COLOR=blue]Next[/COLOR]
    [COLOR=blue]Next[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

Bon courage et gros bisous

 

[C@thy]

Re : Tri sur 2 critères

Merci Hasco, tu es encore et toujours un chouchou
moi tester ca lundi et moi te dire
Bisous bisous

C@thy

 

[C@thy]

Re : Tri sur 2 critères

Re coucou,

je viens de me rendre compte qu'il n'est pas certain que les utilisateurs aient XL
sur leur PC mais je pense que de toute facon ta soluce peut ouvrir des horizons
par ailleurs j'ai peut-etre aussi mal envisagé la chose
je ne sais pas si on pourrait faire dabord un tri par date qui est unique,
puis un tri par nom de fichier qui contient le thème au début
je réfléchis encore a tout ca...

Bises et encore merci pour l'aide que tu as apportée

Edit: autant pour moi, ta 2eme soluce ne nécessite pas XL
donc a priori tout parait bien, je vais tester demain

big bisous

C@thy

 

[Zon]

Re : Tri sur 2 critères

Salut,

Merci Hasco mais nos noms de fichiers sont différents donc les 2 critères ne sont pas valables...

A+++

 

[C@thy]

Re : Tri sur 2 critères

Coucou les boyz

ah ben mince alors, elle est achement dure ma question!
Zon est dessus depuis une semaine c'est tout dire
merci a vous les garçons vous etes vraiment adorables
est-ce qu'on va y arriver un jour?
Ce fichu problème a-t-il une solution?
Zat iz ze couestion...

Mille bisous

C@thy

 

[Guest]

Re : Tri sur 2 critères

Bonjour,

Je ne comprends pas cette histoire de nom de fichier et de critère.

Je suis allé voir l'autre fil (dans Autres Applications) et n'ai pas trop compris non plus.

C'est pourquoi, j'ai fait avec ce que je comprenais, ici. A savoir obtenir un tableau à deux dimensions trié.

A+

 

[kjin]

Re : Tri sur 2 critères

Bonjour le fil

Je ne comprends pas cette histoire de nom de fichier et de critère

Je me sens moins seul tout à coup
A+
kjin

 

[C@thy]

Re : Tri sur 2 critères

Effectivement c'est pas facile a comprendre donc je réexplique
chaque news concerne un thème : affaires etrangeres, culture etc
ce thème figure en tête du document avec un style sous thème
le nom de chaque fichier commence par ce thème suivi du titre de la news
Dans le sommaire du doc de synthèse on trouve tous les thèmes triés par ordre alpha
puis sous chaque thème les news par ordre décroissant de date de derniere modif
pour l'instant le doc de synthèse est bien trié par thème mais pas par date décroissante
c'est le seul point qui reste et qui me pose vraiment problème

Biz

C@thy