Simplifier macro trier,filtrer, transferer

[mfb]

Bonjour Excel,
J'ai réalisé une macro par enregistrement qui trie, ordonne, et transfère des dates. d'une feuille à l'autre.
Le résultat est OK. Bien que module soit conséquent je peux m'en satisfaire.
Mais comme il y a toujours a apprendre alors je m'en remets à vous pour éventuellement alléger ce module dans sa formulation.
voir le fichier joint
Par avance MERCI

 

[pierrejean]

Bonjour mfb

Un essai a base de dictionnaires

 

[mfb]

Bonjour pierrejean.
Toujours aussi rapide et efficace Merci
J'avais bien entendu parlé de Dico mais jamais manipulé.
Je me suis permis d'ajouter le classement des dates les moins anciennes.
Ceci en recopiant bêtement le module. Ca marche.
Y a t-il des remarques
A+
Daniel

 

[pierrejean]

Re

Les dictionnaires étant déjà constitués et classés il suffit de prendre les 5 dernières valeurs

 

[mfb]

Re,
Que de plus sinon que c'est super.
Alors Merci à toi piserrejean ainsi qu'à tous ceux qui ont ouvert mon message.
A tous BON NOEL
A+
Daniel

 

[mapomme]

Bonjour @mfb, @pierrejean ,

Pour le FUN, trois méthodes donnant trois résultats différents. Les deux premières tiennent compte qu'il peut exister des doublons de dates. Pas d'utilisation de dictionary (donc compatible MAC)

 

[mfb]

Bonjour à tous.
Merci à "ma pomme" pour le fun.
Mais désolé j'ai opté pour la solution de pierrejean.
Je rencontre toutefois un PB en voulant intégrer le module Pierrejean dans une macro du fichier existant ça BUG.
message variable non déclarée pour Dico_M et toutes les autres ....J'ai bien essayé un bouton indépendant avec ou mode creation en private ou public sub rien y fait.
Le module que je cherche à insérer est dans le dernier fil de pierrejean
Alors qu'elle blague ai-je fait ?
Par avance merci
Daniel

 

[klin89]

Bonsoir à tous,

Avec la fonction de tableau Filter
Restitution en Feuil3

Option Explicit
Sub test()
Dim x, e, n As Long
    Sheets("Feuil3").Rows("1:5").ClearContents
    With Sheets("Feuil1").Range("e7").CurrentRegion
        For Each e In Array(Array("M", "a1"), Array("F", "e1"))
            x = Filter(.Parent.Evaluate("transpose(if(" & .Columns(3).Address & _
                  "=""" & e(0) & """,row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
            n = UBound(x)
            If n > -1 Then
                x = Application.Index(.Value2, Application.Transpose(x), [{1,2,3}])
                If n > 0 Then
                    n = UBound(x, 1)
                    mySort x, LBound(x, 1), n, 2
                Else: n = 1
                End If
                'restitution
                With Sheets("Feuil3").Range(e(1))
                    .Offset(, 1).Resize(5).NumberFormat = "dd/mm/yyyy"
                    If n = 1 Then
                        .Resize(n, UBound(x)).Value = x
                    Else
                        If n < 5 Then
                            .Resize(n, UBound(x, 2)).Value = x
                        Else
                            .Resize(5, UBound(x, 2)).Value = x
                        End If
                    End If
                End With
            End If
        Next
    End With
End Sub

Private Sub mySort(a, LB As Long, UB As Long, ref As Long)
    Dim i As Long, ii As Long, iii As Long, temp
    For i = LB To UB - 1
        For ii = i + 1 To UB
            If a(i, ref) > a(ii, ref) Then
                For iii = LBound(a, 2) To UBound(a, 2)
                    temp = a(i, iii): a(i, iii) = a(ii, iii): a(ii, iii) = temp
                Next
            End If
        Next
    Next
End Sub

klin89

 

[pierrejean]

Re
@mfb

Si tu n'es pas un puriste du Vba
Supprime le Option explicit
Sinon déclare les variables (Elles sont déclarées toutes en Variable sans l'option explicit)

 

[mfb]

Bonjour,
Merci Klin89 C'est une solution qui marche. Un peu trop complexe pour mes petites connaissances VBA.
Je poursuit avec la solution de pierrejean
J'ai supprimé "option explicit" c'est ok plus de variables à déclarer.
Maintenant ça bloque au niveau du report en feuil2 ou le bug m'indique "l'indice n'appartient pas à la sélection". Jai essayé avec Activate feuill1 et ou feuil2. Rien y fait.
Un petit coup pouce serait le bien venu.
Merci d'avance
Daniel

 

[pierrejean]

Re
vérifie le nom de la feuille de destination (feuil2 est rare plutôt Feuil2 ??)

 

[mfb]

Re,
Mystère. Toutes les feuilles sont notées Feuil1 ou Feuil2.
Cela semble bon puisque le Raz de début de "test" avec Feuil2 fonctionne .
Es ce que cela peut être généré par des événements précédant "test" ?
Si oui Le bout de code précédant "test" pourrait peut être utile. Si oui je fait le nécessaire.
Daniel

 

[pierrejean]

Re
peux-tu poster une copie de ton fichier sans données confidentielles ?

 

[mfb]

Re,
Ok. Le fichier est lourd il va me falloir un peu temps pour l'expurger.
Alors un peu de patience.
Daniel

 

[mfb]

Re,
Voici en Pj le fichier expurger.
Dans le module j'ai converser tout ce précède "test" et supprimé toute la suite.
la machine infernale que j'avais conçu (mais qui marche) a été conservée pour l'instant. "test" a été installé juste avant avec ' pour le rendre inactif. Dès que ' est retiré bingo ça bug.
J'espère ainsi que cela facilitera les recherches du pb.
Ne pas se choquer j'ai changé le sens d'affichage des dates + anciennes.
Daniel