Tri Scripting dictionnary

Bonjour à toutes et tous,

j'ai une question concernant le script ci dessous (fonctionnant correctement):

comment procéder afin de trier l'affichage rendu

En effet Statut peut correspondre à

Active / Rejected / Negociation / Submitted / Drafting / Closed (celui là non affiché)

à l'heure actuelle tout se reporte bien mais je voudrais par exemple afficher les rejected tout à la fin, aussi est il possible d'organiser l'affichage dans l'ordre souhaité et si oui comment svp?

If statut <> "Closed" Then
If Not dic_statuts.exists(statut) Then Set dic_statuts(statut) = CreateObject("Scripting.Dictionary")
Set dic_projects = dic_statuts(statut)
dic_projects(id_projet) = Array(statut, Acronym, Topic, début, fin, commentaire, Investigator_firstname, Investigator_name, CLng(Budget_Requested))
Set dic_statuts(statut) = dic_projects

End If

Merci à vous par avance

personne pour m'éclairer svp?

Bonjour,

j'avais vu ton post, mais sans fichier, je n'y voyais pas clair ... donc mets un extrait.

Si tu veux faire du tri d'un dictionnaire ... transfert le dico dans un tableau que tu tries

    ' transfert dans un tableau des clés pour tri
    Tbl = dico.keys
    QuickSort Tbl

    ' rechargement du dictionnaire avec clés triées et application des valeurs
    dico.RemoveAll
    For i = LBound(Tbl) To UBound(Tbl)
        dico(Tbl(i)) = 1
    Next i

    ' lecture des clés et valeurs
    For Each Cle In dico.keys
        Debug.Print Cle
    Next

avec

Public Sub QuickSort(vArray As Variant, _
  Optional ByVal inLow As Long = -1, _
  Optional ByVal inHi As Long = -1)
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long
  inLow = IIf(inLow = -1, LBound(vArray), inLow)
  inHi = IIf(inHi = -1, UBound(vArray), inHi)
  tmpLow = inLow
  tmpHi = inHi
  pivot = vArray((inLow + inHi) \ 2)
  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend
     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend
     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend
  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub

Merci pour votre retour Steelson.

Public Sub Reports()

 Dim tb_projects As ListObject
    Dim dic_statuts As Object, dic_projects As Object
    Dim i As Integer
    Dim PI_interne As String, Acronym As String, Topic As String, début As Variant, fin As Variant, commentaire As String, statut As String, chemin As String, fichier As String
    Dim Investigator_firstname As String, Investigator_name As String, Budget_Requested As Currency
    Dim id_projet As Variant, clé As Variant, Cancel As Boolean, iRow2 As Integer, sData As String, x As Integer, iRow1 As Integer, destination As String, S As String
    Dim wb As Workbook
    Dim project_Range As Variant

    Set dic_statuts = CreateObject("Scripting.Dictionary")
    Set tb_projects = [Projects].ListObject
    With tb_projects
        For i = 0 To .ListRows.Count
            id_projet = .ListColumns("Id_Project").DataBodyRange.Rows(i)
            Acronym = .ListColumns("Acronym").DataBodyRange.Rows(i)
            Topic = .ListColumns("Topic").DataBodyRange.Rows(i)
            début = .ListColumns("Start_Date").DataBodyRange.Rows(i)
            fin = .ListColumns("End_Date").DataBodyRange.Rows(i)
            commentaire = .ListColumns("Comments").DataBodyRange.Rows(i)
            statut = .ListColumns("Status").DataBodyRange.Rows(i)

             With Worksheets("Investigators")
                On Error Resume Next
               project_Range = Application.Match(id_projet, .Range("B:B"), 0)

                Investigator_firstname = Empty: Investigator_name = Empty
                If Err = 0 Then
                    Investigator_firstname = .Range("A:G")(project_Range, 3)
                    Investigator_name = .Range("A:G")(project_Range, 4)
                End If
            End With

                  With Worksheets("Budget")
                On Error Resume Next
               project_Range = Application.Match(id_projet, .Range("A:A"), 0)

                                 Budget_Requested = Empty
                If Err = 0 Then
                    Budget_Requested = .Range("A:O")(project_Range, 15)
                           End If
            End With

             If statut <> "Closed" Then
            If Not dic_statuts.exists(statut) Then Set dic_statuts(statut) = CreateObject("Scripting.Dictionary")
            Set dic_projects = dic_statuts(statut)
            dic_projects(id_projet) = Array(statut, Acronym, Topic, début, fin, commentaire, Investigator_firstname, Investigator_name, CLng(Budget_Requested))
            Set dic_statuts(statut) = dic_projects

            End If
        Next i
    End With

puis plus loin lors de l'écriture dans le fichier

i = 0
For Each clé In dic_statuts
Set dic_projects = dic_statuts(clé)
.Range("A4").Offset(i).Resize(dic_projects.Count, 9) = Application.Transpose(Application.Transpose(dic_projects.Items))
i = i + dic_projects.Count
Next clé

je comprend donc qu'il le faut trier tb_projects et appliquer un sort adapté ?

tu n'as pas plutôt un extrait de ton fichier ?

salut Steelson

désolé pour mon délai de retour mais j'ai mis en place un fichier de démo ce qui m'a pris du temps

le fichier test contient les données et va compléter un rapport dans le document dest

je souhaiterais donc organiser l'affichage de sorte à ne pas avoir les abandonned et rejected juste après les active

j'aimerais avoir dans l'ordre Active / Submitted / negociation / Drafting / Abandonned / Closed (celui là non affiché)

merci par avance pour ton aide

bon weekend par avance

Je vais arrêter là pour 2 raisons :

1. problème d'indentation du code, déjà signalé je me souviens https://forum.excel-pratique.com/excel/olmail-a-differentes-personnes-en-meme-temps-147630/2#p909679
2. erreur 424 objet requis chez moi, donc je ne peux pas faire tourner ta macro , sincèrement désolé

Une piste par contre, si tu présentes ensuite tes résultats sous forme de TCD, tu peux arranger l'ordre comme tu veux.

Merci à vous pour votre retour.

Je vais tenter de voir comment procéder.

Bon week-end