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
patricktoulon à dit:
oui Laurent 5 minute j'ajoute le trishellmetsner
Cliquez pour agrandir...
Avec plaisir de le tester en tris croissant et décroissant et tester sur les mêmes valeurs, je pense avoir trouver un code assez performant.
j'ai déjà tester sur 10 000 valeurs mais avec les mêmes valeurs que toi c'est mieux
on fait le teste que sur le tris uniquement
' le tableau est envoyer pour être trié et on compare le temps sur les mêmes valeurs
tt = Timer()
IntroSortDescending t
MsgBox Timer() - tt
 
Vote positif 0 Vote négatif
Re @patricktoulon

juste pour info tu as mis combien en temps pour la plus rapide ?
Voila j'ai les temps dans l'odre avec ton fichier et tes codes

patricktoulon à dit:
les modules sont classés de la méthode la plus lente à la plus rapide
Cliquez pour agrandir...
Le plus rapide chez moi avec ton code le plus rapide c'est 0,05 sec est chez toi ?

Ensuite avec le mien je te montre comme cela ont peux vraiment comparer.
 
Vote positif 0 Vote négatif
par contre les bubbles chez toi sont plus rapide chez moi c'est 09.xxxxx et 11.64xxx
autrment dit plus de 40% de mieux
par contre les plus rapide chez moi sont un peu plus lentes chez toi
et ben donne le ton code saucisse !!!!!!
 
Vote positif 0 Vote négatif
Re @patricktoulon

je t'offre mon code. je divise le temps le plus rapide chez toi par 3,3


Module Standard (TrisCroissant)
Code: 
Sub TestQuickSortCroissant()
    Dim t() As Variant
    Range(Cells(1, 3), Cells(Cells(65536, 3).End(xlUp).Row, 3)).Clear
    t = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
  
    tt = Timer()
    IntroSort t
    MsgBox Timer() - tt
  
    ' Afficher le tableau tris Croissant
    Cells(1, 3).Resize(UBound(t, 1), UBound(t, 2)) = t
    'Dim i As Long
    'For i = LBound(t) To UBound(t)
        'Debug.Print t(i)
    'Next i
End Sub

Sub IntroSort(arr() As Variant)
    Dim low As Long, high As Long
    low = LBound(arr)
    high = UBound(arr)
    IntroSortRecursive arr, low, high, 2 * Log2(high - low + 1)
End Sub

Sub IntroSortRecursive(arr() As Variant, ByVal low As Long, ByVal high As Long, ByVal maxDepth As Long)
    If high <= low Then Exit Sub
    If maxDepth = 0 Then
        ' Si la profondeur maximale est atteinte, utilisez un algorithme de tri plus simple (par exemple, le tri par insertion).
        InsertionSort arr, low, high
    Else
        Dim pivotIndex As Long
        pivotIndex = Partition(arr, low, high)
        IntroSortRecursive arr, low, pivotIndex - 1, maxDepth - 1
        IntroSortRecursive arr, pivotIndex + 1, high, maxDepth - 1
    End If
End Sub

Function Partition(arr() As Variant, ByVal low As Long, ByVal high As Long) As Long
    Dim pivot As Variant
    Dim i As Long, j As Long
    Dim temp As Variant
  
    ' Choisissez un pivot médian
    Dim mid As Long
    mid = (low + high) \ 2
    pivot = arr(mid, 1)
  
    i = low
    j = high
  
    Do
        While arr(i, 1) < pivot
            i = i + 1
        Wend
        While arr(j, 1) > pivot
            j = j - 1
        Wend
      
        If i <= j Then
            ' Échange les éléments
            temp = arr(i, 1)
            arr(i, 1) = arr(j, 1)
            arr(j, 1) = temp
            i = i + 1
            j = j - 1
        End If
    Loop While i <= j
  
    Partition = i
End Function

Sub InsertionSort(arr() As Variant, ByVal low As Long, ByVal high As Long)
    Dim i As Long, j As Long
    For i = low + 1 To high
        j = i
        While j > low And arr(j, 1) < arr(j - 1, 1)
            Swap arr(j, 1), arr(j - 1, 1)
            j = j - 1
        Wend
    Next
End Sub

Sub Swap(ByRef a As Variant, ByRef b As Variant)
    Dim temp As Variant
    temp = a
    a = b
    b = temp
End Sub

Function Log2(ByVal x As Double) As Long
    Log2 = WorksheetFunction.RoundDown(Log(x) / Log(2), 0)
End Function


Module Standard (TrisDecroissant)
Code: 
Sub TestQuickSortDeCroissant()
    Dim t() As Variant
    Range(Cells(1, 3), Cells(Cells(65536, 3).End(xlUp).Row, 3)).Clear
    t = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
    
    tt = Timer()
    IntroSort t
    MsgBox Timer() - tt
    
    ' Afficher le tableau tris Croissant
    Cells(1, 3).Resize(UBound(t, 1), UBound(t, 2)) = t
    'Dim i As Long
    'For i = LBound(t) To UBound(t)
        'Debug.Print t(i)
    'Next i
End Sub

Sub IntroSort(arr() As Variant)
    Dim low As Long, high As Long
    low = LBound(arr)
    high = UBound(arr)
    IntroSortRecursive arr, low, high, 2 * Log2(high - low + 1)
End Sub

Sub IntroSortRecursive(arr() As Variant, ByVal low As Long, ByVal high As Long, ByVal maxDepth As Long)
    If high <= low Then Exit Sub
    If maxDepth = 0 Then
        ' Si la profondeur maximale est atteinte, utilisez un algorithme de tri plus simple (par exemple, le tri par insertion).
        InsertionSort arr, low, high
    Else
        Dim pivotIndex As Long
        pivotIndex = Partition(arr, low, high)
        IntroSortRecursive arr, low, pivotIndex - 1, maxDepth - 1
        IntroSortRecursive arr, pivotIndex + 1, high, maxDepth - 1
    End If
End Sub

Function Partition(arr() As Variant, ByVal low As Long, ByVal high As Long) As Long
    Dim pivot As Variant
    Dim i As Long, j As Long
    Dim temp As Variant
    
    ' Choisissez un pivot médian
    Dim mid As Long
    mid = (low + high) \ 2
    pivot = arr(mid, 1)
    
    i = low
    j = high
    
    Do
        While arr(i, 1) > pivot
            i = i + 1
        Wend
        While arr(j, 1) < pivot
            j = j - 1
        Wend
        
        If i <= j Then
            ' Échange les éléments
            temp = arr(i, 1)
            arr(i, 1) = arr(j, 1)
            arr(j, 1) = temp
            i = i + 1
            j = j - 1
        End If
    Loop While i <= j
    
    Partition = i
End Function

Sub InsertionSort(arr() As Variant, ByVal low As Long, ByVal high As Long)
    Dim i As Long, j As Long
    For i = low + 1 To high
        j = i
        While j > low And arr(j, 1) < arr(j - 1, 1)
            Swap arr(j, 1), arr(j - 1, 1)
            j = j - 1
        Wend
    Next
End Sub

Sub Swap(ByRef a As Variant, ByRef b As Variant)
    Dim temp As Variant
    temp = a
    a = b
    b = temp
End Sub

Function Log2(ByVal x As Double) As Long
    Log2 = WorksheetFunction.RoundDown(Log(x) / Log(2), 0)
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…