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

patricktoulon · 17 Octobre 2023

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

patricktoulon · 8 Novembre 2023

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

Dranreb · 8 Novembre 2023

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.

patricktoulon · 8 Novembre 2023

alors sur 10 000 item
avec des numeriques >0.03
avec du texte > 0.05

sur 100 000 items
avec des numeriques >0.34
avec du texte > 0.64

j'ai bien envie de tester la fusion mais il va faloir que je la réécrive en 2dim

patricktoulon · 8 Novembre 2023

Dranreb à dit:
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.

argument recevable

patricktoulon · 8 Novembre 2023

toujours est il que le tri quicksort effectif que ce soit en 1 dim ou 2 dim reste le plus rapide
quand je pense que de (bubble Cro-Magnon 8sec) pour 10 000 et 0.03 avec quiksort
ca fait du combien pour 100 ça

RyuAutodidacte · 8 Novembre 2023

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

patricktoulon · 8 Novembre 2023

re
oui ton idée est un mix de la fusion et du bubble sauf que tu met en jeu une collection

RyuAutodidacte · 8 Novembre 2023

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 … ???

RyuAutodidacte · 8 Novembre 2023

patricktoulon à dit:
sauf que tu met en jeu une collection

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 … ?

RyuAutodidacte · 8 Novembre 2023

Dranreb à dit:
J'ai repris mes recherches et ressorti un vieux module de classe TableIndex qui marchait très bien.
Je n'arrive plus à retrouver les circonstances qui m'ont fait trouver, même optimisée, la fusion plus rapide.

j'ai pas pu tester

y a de l'ActiveX

patricktoulon · 8 Novembre 2023

re

RyuAutodidacte · 8 Novembre 2023

@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

dysorthographie · 8 Novembre 2023

bonsoir,
j'imagine que vous êtes déjà tombé sur ce site!

Mise en oeuvre de tris en Visual Basic

www.giacomazzi.fr

RyuAutodidacte · 9 Novembre 2023

Coucou Robert

dysorthographie à dit:
j'imagine que vous êtes déjà tombé sur ce site!

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

RyuAutodidacte · 9 Novembre 2023

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

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

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Accro

XLDnaute Impliqué

XLDnaute Impliqué

Partager cette page

Statistiques des forums