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

XL 2013 les machistes (utilisateurs de Mac OS peuvent ils tester ceci

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
@RyuAutodidacte m' a rappelé un lien vers un amis de l'autre monde concernant une classe pseudo dictionnaire pour MAC
malgré que j'apprécie beaucoup l'auteur (avec qui j'ai même collaboré sur l’accélérateur de requête entre autres ) ,je trouve que c'est un peu usine à gaz

j'ai donc fait les choses à ma façon
mais avant d'aller plus loin car des idées j'en ai plein ,si vous êtes un utilisateur sur MAC pouvez vous tester ce pseudo dictionnaire
sur Windows ça match il me faut confirmation sur MAC

Merci pour vos retours
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
re
l'erreur était dans la création
j'en crée plus
je remove les doublons et je garde que le nombre voulu

j'aimerais aussi que dranreb me parle de l'utilisation de l'indexation et surtout qu'est que ca veut dire dans ce contexte
 
Vote positif 0 Vote négatif
L'indexation permet de garder trace des numéros de lignes d'origine.
C'est utile dans au moins deux cas:
1) — Lorsqu'on veut classer un tableau comportant de nombreuses colonnes, ainsi on n'a pas à déplacer les données elles mêmes pendant l'indexation, ce qui serait long,
2) — Lorsqu'on veut pouvoir indiquer, sans qu'il soit nécessaire de les y rechercher à postériori, à quelles lignes de la base se trouvent une valeur choisie dans une ComboBox.
 
Vote positif 0 Vote négatif
argument recevable 👍
 
Vote positif 0 Vote négatif
Re @patricktoulon , @Dranreb
j'ai voulu checker une piste de pré-Tri sur une boucle rassemblant dans un array, un array les nombres/lettres qui son proche … j'avais commencé en mettant les arrays dans une collection puis aujourd'hui je me suis dit que ca serait peut être plus rapide dans un array
Schématiquement on a dans un array : Array(1)(Array(éléments quasi identiques)) … ainsi de suite
Le but était de minimiser les boucles et interventions en triant chaque array d'array et en triant l'array principal via Array(x)(1) permettant d'assembler le tout dans l'odre en prenant chaque array les un aprés les autres
le code pour que vous vous fassiez une idée (juste la partie ou je rassemble … checker la variable TA :
VB: 
Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, Tmps!
  
    Tmps = Timer
    TB = Cells(1).CurrentRegion.Value
    For Each T In TB
        ReDim NewTB(1 To 1)
        L = Mid(T, 1, Len(T) - 1): S = Len(T): cle = L & "|" & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = T: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(T)
        End If
    Next
    Debug.Print Timer - Tmps
    Stop
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re
Du coup sur 500 000 ça accélère le processus ou pas ?
As tu une idée d’améliorer le principe pour optimiser la performance / rapidité ?
Je suis curieux de savoir quel est le nombre de boucles et d’interventions avec ce principe … ???
 
Vote positif 0 Vote négatif
patricktoulon à dit:
sauf que tu met en jeu une collection
Cliquez pour agrandir...
oui c'est vrai il y a encore une collection sauf que la différence c'est que avant les arrays étaient les items de la collection alors que la il n'y a plus d'item dans la collection et tout est mis dans un tableau, ce qui m'a fait gagner 0,5 seconde sur le temps c'est pas négligeable, … faudrait trouver un système sans collection pour voir la différence …
car là tout est pré rangé sur une boucle

PS : je n'ai pas l'impression que ca fait comme le bubble … ?
 
Dernière édition:
Vote positif 0 Vote négatif
@patricktoulon
si on veut trier un tableau en SortBubble dont chaque indice contient un array
ce code est ok si on se base sur T(x)(1) > T(y)(1) ? car j'ai l'impression que ce n'est pas ok … ?
VB: 
Function SortBubbleTB(t) 'fonction Tri à bulle classique modifé
    Dim temp, i&, a&
    For i = LBound(t) To UBound(t) - 1
        For a = i To UBound(t)
            Q = Q + 1
            If t(i)(1) > t(a)(1) Then temp = t(i): t(i) = t(a): t(a) = temp: ch = ch + 1
        Next
    Next
     SortBubbleTB = t
End Function
 
Vote positif 0 Vote négatif
Coucou Robert 😉
dysorthographie à dit:
j'imagine que vous êtes déjà tombé sur ce site!
Cliquez pour agrandir...
oui j'y suis tombé ce soir en faisant des recherches, on est connecté tous les 2 ma parole 🤣😉

Re @patricktoulon ,
j'ai trouvé d'ou venait mon pb … des array non en base 1 il faudra que je cherche pourquoi … mais pour mes tests je me suis pas pris la tête et j'ai mis option base 1

PS : comme les tests son sur des chiffres j'ai essayé qu'avec des tableaux mais t'y perds un minime chouia par rapport à la collection support

Ce test je l'ai fait sur ton SortBubble en utilisant mon pré-Tri tremplin :
Avant :
7,71 sec
50004999 TOURS DE BOUCLE
25120628 INTERVERTIONS
Après :
4,97 sec
4387680 TOURS DE BOUCLE
2210423 INTERVERTIONS

VB: 
Option Base 1

Dim Q&
Dim ch&

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, Tmps!

   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    TB = Cells(1).CurrentRegion.Value
    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & "|" & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t)
        End If
    Next
 
    For i = 1 To UBound(TA): TA(i) = SortBubble(TA(i)): Q = Q + 1:: Next
 
    TA = SortBubbleTB(TA)
    ReDim TB(1 To 1)
    n = 0
    For Each arr In TA
        Q = Q + 1
        ReDim Preserve TB(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TB(i + n) = arr(i)
        Next
        n = UBound(TB)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TB)) = Application.Transpose(TB)
End Sub


Function SortBubble(t) 'fonction Tri à bulle classique
    Dim temp, i&, a&
    For i = LBound(t) To UBound(t) - 1
        For a = i To UBound(t)
            Q = Q + 1
            If t(i) > t(a) Then temp = t(i): t(i) = t(a): t(a) = temp: ch = ch + 1
        Next
    Next
     SortBubble = t
End Function

Function SortBubbleTB(t) 'fonction Tri à bulle classique modifé
    Dim temp, i&, a&
    For i = LBound(t) To UBound(t) - 1
        For a = i To UBound(t)
            Q = Q + 1
            If t(i)(1) > t(a)(1) Then temp = t(i): t(i) = t(a): t(a) = temp: ch = ch + 1
        Next
    Next
     SortBubbleTB = t
End Function

Edit : modif , refait les test sur Mac M1
 
Dernière édition:
Vote positif 0 Vote négatif
Avec le insertion sort :
Avant :
7,62 sec
49995000 TOURS DE BOUCLE
25120628 INTERVERTIONS
Après :
4,96 sec
4377681 TOURS DE BOUCLE
2210423 INTERVERTIONS

VB: 
Option Base 1

Dim Q&, ch&, P&

'Tri par insertion (Insertion sort)

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, Tmps!

   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    TB = Cells(1).CurrentRegion.Value
    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & "|" & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t)
        End If
    Next
 
    For i = 1 To UBound(TA): TA(i) = SortInsertion1(TA(i)): Q = Q + 1:: Next
 
    TA = SortInsertion1TB(TA)
    ReDim TB(1 To 1)
    n = 0
    For Each arr In TA
        Q = Q + 1
        ReDim Preserve TB(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TB(i + n) = arr(i)
        Next
        n = UBound(TB)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TB)) = Application.Transpose(TB)
End Sub

Function SortInsertion1(t)
    Dim temp, i&, a&
    For i = LBound(t) + 1 To UBound(t)
        For a = LBound(t) To i - 1
            If t(i) < t(a) Then TP = t(i): t(i) = t(a): t(a) = TP: ch = ch + 1
            Q = Q + 1
        Next
    Next
    SortInsertion1 = t
End Function
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Function SortInsertion1TB(t)
    Dim temp, i&, a&
    For i = LBound(t) + 1 To UBound(t)
        For a = LBound(t) To i - 1
            If t(i)(1) < t(a)(1) Then TP = t(i): t(i) = t(a): t(a) = TP: ch = ch + 1
            Q = Q + 1
        Next
    Next
    SortInsertion1TB = t
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…