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 · 18 Octobre 2023

allez version finale

patricktoulon · 24 Octobre 2023

@Dranreb donc chez toi ma classe marche avec l'astuce ?

Dranreb · 24 Octobre 2023

RyuAutodidacte · 24 Octobre 2023

Re
@patricktoulon, @Dranreb, @dysorthographie
on est bien d'accord … le ToTable doit logiquement ne renvoyer que les items dans le tableau ?
car le but et de récupérer la donnée voulue et non les ID/Clé …

Edit : Quel est l'algorithme le plus efficace pour le tri pour vous ?

RyuAutodidacte · 24 Octobre 2023

Le Tri Shell Metzner peut être ?

Dranreb · 24 Octobre 2023

RyuAutodidacte à dit:
Edit : Quel est l'algorithme le plus efficace pour le tri pour vous ?

J'utilise couramment un système consistant à établir par insertion de petites listes de 20 éléments toutefois extensibles tant que celui à y intégrer n'est pas inférieur au dernier rangé, puis à les interclasser deux à deux jusqu'à n'obtenir qu'une liste unique. Point important: ça ne classe pas les données, ça établit une table de numéros de lignes dans l'ordre où il faudra les parcourir. Je l'ai en versions colonne unique et plusieurs colonnes. Ça fait un bon moment que je l'utilise, depuis que je me suis aperçu que, dans ce mode indexation et non pas classement, pour des centaines de milliers d'éléments, il était un tant soit peu plus performant que le QuickSort, qui est certainement le meilleur autre.

patricktoulon · 24 Octobre 2023

@Dranreb ok donc pour moi c'est bon j'ai du faire un truc à l'envers la première fois

ryu
la méthode la plus rapide est la méthode quiksort mais elle est également plus lourde en mémoire
après il il a le tri dit("à bulle ") qui consiste dans une double boucle dont la première sert de répétiteur à la 2d ainsi qu'elle incrémente le départ de cette dernière
et il y a la même que la 2d méthode en mono boucle qui consiste a jumpé l'incrémentation de la boucle mais qui a le même principe que le tri à bulle par contre selon le désordre elle sera plus ou moins long

donc

la quicksort plus rapide mais plus lourde
la bulle version 1 plus longue mais moins lourde que quicksort
la bulle version 2 longueur variable selon désordre mais moins lourde que quicksort

et non!!! la fonction ToTable renvoie bien un tableau 2 dim cle/item

en ce qui concerne ma version sans collection on est tout bon

patricktoulon · 24 Octobre 2023

Alors Ryu a tu fini ta classe ?

Dranreb · 24 Octobre 2023

patricktoulon à dit:
la méthode la plus rapide est la méthode quiksort

Je venais de dire que la mienne était légèrement plus rapide.

patricktoulon · 24 Octobre 2023

re
@Dranreb tu peux me donner la base de ta méthode

RyuAutodidacte · 24 Octobre 2023

patricktoulon à dit:
Alors Ryu a tu fini ta classe ?

Dsl Patrick dimanche pas chez moi et semaine taf mais ça arrive …

@Dranreb

Dranreb à dit:
J'utilise couramment un système consistant à établir par insertion de petites listes de 20 éléments toutefois extensibles tant que celui à y intégrer n'est pas inférieur au dernier rangé, puis à les interclasser deux à deux jusqu'à n'obtenir qu'une liste unique. Point important: ça ne classe pas les données, ça établit une table de numéros de lignes dans l'ordre où il faudra les parcourir. Je l'ai en versions colonne unique et plusieurs colonnes. Ça fait un bon moment que je l'utilise, depuis que je me suis aperçu que, dans ce mode indexation et non pas classement, pour des centaines de milliers d'éléments, il était un tant soit peu plus performant que le QuickSort, qui est certainement le meilleur autre.

Je veux bien ton algo si c’est possible stp , j’ai un tableau 1 dim (si t’as les commentaires c’est un plus )

RyuAutodidacte · 24 Octobre 2023

Re @patricktoulon

RyuAutodidacte à dit:
Hello @patricktoulon
J'ai une question sur ton reverse :
La clé censé être unique si tu fais un reverse alors que tu as 2 items de même valeur… ca va poser problème … ? car tu ca fera 2 clés identique … par la suite
tu as déjà fait des reverses avec le dictionnaire ? et dans quels cas ?

Je reviens dessus car il me semble pas que tu es répondu …
Même si tu es avec 2 tableaux et que tus as des items identiques ca ne pourra jamais être des clés avec un reverse … … ?

patricktoulon · 24 Octobre 2023

re
keyItemreverse est a utiliser avec parsimonie
il est évident que si tu a des doublons dans les valeurs (les items) ça n'a plus la teneur d'un dico après reverse
cependant pour le tri par les valeurs et non les clés ,
il peut être intéressant de pourvoir faire un reverse /tri/reverse
de même que si c'est un exercice sans doublons d'items on peut faire un reverse
attention le reverse ne peut être utilisé que pour des valeurs numériques ou texte
si tu a des objects dans tes items c'est mort
d’ailleurs il faudrait que je le bloque en cas d'object

patricktoulon · 24 Octobre 2023

voila si un seul object range ou autres est entré dans les items le reverse est bloqué

c'est pas beau ça

Dranreb · 24 Octobre 2023

patricktoulon à dit:
tu peux me donner la base de ta méthode

La base, je dirais, c'est ma description. Pour ce qui est des codes, la version pour une seule colonne fait partie de mon module de service MSujetCBx :

VB:

Sub IndexerFus1Col(TIdx() As Long, TDon(), _
   Optional ByVal Croissant As Boolean = True, Optional ByVal LMax As Long)
   Dim NR As Long, ÀFusionner As New Collection, _
       L1 As Long, TFus1() As Long, N1 As Long, Arg1, _
       L2 As Long, TFus2() As Long, N2 As Long, Arg2
   If LMax <= 0 Then LMax = UBound(TDon, 1)
   ReDim TIdx(1 To &HFFF&)
   NR = 1: TIdx(1) = 1: L1 = 1: Arg1 = TDon(1, 1)
   If VarType(Arg1) = vbString Then If Arg1 = "" Then Arg1 = Empty: TDon(1, 1) = Empty
   For L2 = 2 To LMax: Arg2 = TDon(L2, 1)
      If VarType(Arg2) = vbString Then If Arg2 = "" Then Arg2 = Empty: TDon(L2, 1) = Empty
      If DansLOrdre(Arg1, Arg2, Croissant, L1 < L2) Then
         NR = NR + 1: If NR > UBound(TIdx) Then ReDim Preserve TIdx(1 To NR Or &HFFF&)
         TIdx(NR) = L2: L1 = L2: Arg1 = Arg2
      ElseIf NR < 20 Then
         For N1 = 1 To NR - 1: L1 = TIdx(N1): If DansLOrdre(Arg2, TDon(L1, 1), Croissant, L1 > L2) Then Exit For
            Next N1
         NR = NR + 1: If NR > UBound(TIdx) Then ReDim Preserve TIdx(1 To NR Or &HFFF&)
         For N2 = NR To N1 + 1 Step -1: TIdx(N2) = TIdx(N2 - 1): Next N2
         TIdx(N1) = L2: L1 = TIdx(NR): Arg1 = TDon(L1, 1)
      Else: ReDim Preserve TIdx(1 To NR): ÀFusionner.Add TIdx: NR = 1
         TIdx(1) = L2: L1 = L2: Arg1 = Arg2: End If
      Next L2
   ReDim Preserve TIdx(1 To NR)
   Do While ÀFusionner.Count > 0
      ÀFusionner.Add TIdx
      TFus1 = ÀFusionner(1): N1 = 1: ÀFusionner.Remove 1
      TFus2 = ÀFusionner(1): N2 = 1: ÀFusionner.Remove 1
      ReDim TIdx(1 To UBound(TFus1) + UBound(TFus2))
      L1 = TFus1(1): Arg1 = TDon(L1, 1)
      L2 = TFus2(1): Arg2 = TDon(L2, 1)
      NR = 0: Do: NR = NR + 1
         If DansLOrdre(Arg1, Arg2, Croissant, L1 < L2) Then
               TIdx(NR) = L1: N1 = N1 + 1: If N1 <= UBound(TFus1) Then L1 = TFus1(N1): Arg1 = TDon(L1, 1) Else GoTo Fin2
         Else: TIdx(NR) = L2: N2 = N2 + 1: If N2 <= UBound(TFus2) Then L2 = TFus2(N2): Arg2 = TDon(L2, 1) Else Exit Do
            End If
         Loop
      Do: NR = NR + 1: TIdx(NR) = TFus1(N1): N1 = N1 + 1: Loop Until N1 > UBound(TFus1): GoTo FusS
Fin2: Do: NR = NR + 1: TIdx(NR) = TFus2(N2): N2 = N2 + 1: Loop Until N2 > UBound(TFus2)
FusS: Loop
   End Sub
Private Function DansLOrdre(ByVal Val1, ByVal Val2, ByVal Croissant As Boolean, ByVal ParDéf As Boolean) As Boolean
   Dim Typ1 As VbVarType, Typ2 As VbVarType, Sens As Integer, Comp As Integer
   Sens = 2 * -Croissant - 1
   Typ1 = VarType(Val1): Typ2 = VarType(Val2)
   Select Case Typ2
      Case Is <> Typ1: Comp = Sgn(Typ2 - Typ1)
      Case vbString: Comp = StrComp(Val2, Val1) * Sens
      Case vbError: Comp = Sgn(CLng(Val2) - CLng(Val1)) * Sens
      Case vbEmpty: Comp = 0
      Case Else: Comp = Sgn(Val2 - Val1) * Sens: End Select
   If Comp = 0 Then DansLOrdre = ParDéf Else DansLOrdre = Comp > 0
   End Function

La version pour plusieurs colonnes fait partie de mon module MGigogne :

VB:

Sub IndexerParFusions(TIdx() As Long, TDon(), ParamArray ColOrd() As Variant)
   Dim NR As Long, NE As Long, Comp As Integer, ÀFusionner As New Collection, _
       L1 As Long, TFus1() As Long, N1 As Long, _
       L2 As Long, TFus2() As Long, N2 As Long
   If UBound(ColOrd) >= LBound(ColOrd) Then InterpréterParam ColOrd, UBound(TDon, 2), "IndexerParFusion"
   ReDim TIdx(1 To &HFFF&)
   NR = 1
   If Préfiltré Then
      L1 = TLgnFlt(1): TIdx(1) = L1
      For NE = 2 To UBound(TLgnFlt): L2 = TLgnFlt(NE): GoSub Comparer
         If Comp = 1 Then
         NR = NR + 1: If NR > UBound(TIdx) Then ReDim Preserve TIdx(1 To NR Or &HFFF&)
         TIdx(NR) = L2: L1 = L2
      ElseIf NR = 1 Then
         NR = 2: If UBound(TIdx) < 2 Then ReDim Preserve TIdx(1 To &HFFF&)
         TIdx(1) = L2: TIdx(2) = L1
      Else
         ReDim Preserve TIdx(1 To NR): ÀFusionner.Add TIdx: NR = 1
         TIdx(1) = L2: L1 = L2: End If: Next NE
   Else
      If Tronquer Then
         If LMax > UBound(TDon, 1) Then LMax = UBound(TDon, 1)
      Else: LMax = UBound(TDon, 1): End If
      L1 = LBound(TDon, 1): TIdx(1) = L1
      For L2 = L1 + 1 To LMax: GoSub Comparer
         If Comp = 1 Then
            NR = NR + 1: If NR > UBound(TIdx) Then ReDim Preserve TIdx(1 To NR Or &HFFF&)
            TIdx(NR) = L2: L1 = L2
         ElseIf NR < 20 Then
            For N1 = 1 To NR - 1: L1 = TIdx(N1): GoSub Comparer: If Comp < 0 Then Exit For
               Next N1
            NR = NR + 1: If NR > UBound(TIdx) Then ReDim Preserve TIdx(1 To NR Or &HFFF&)
            For N2 = NR To N1 + 1 Step -1: TIdx(N2) = TIdx(N2 - 1)
               Next N2
            TIdx(N1) = L2: L1 = TIdx(NR)
         Else
            ReDim Preserve TIdx(1 To NR): ÀFusionner.Add TIdx: NR = 1
            TIdx(1) = L2: L1 = L2: End If: Next L2
      End If
   ReDim Preserve TIdx(1 To NR)
   Do While ÀFusionner.Count > 0
      ÀFusionner.Add TIdx
      TFus1 = ÀFusionner(1): N1 = 1: ÀFusionner.Remove 1
      TFus2 = ÀFusionner(1): N2 = 1: ÀFusionner.Remove 1
      ReDim TIdx(1 To UBound(TFus1) + UBound(TFus2))
      NR = 0: L1 = TFus1(1): L2 = TFus2(1)
      Do: NR = NR + 1: GoSub Comparer
         If Comp = 1 Then
               TIdx(NR) = L1: N1 = N1 + 1: If N1 <= UBound(TFus1) Then L1 = TFus1(N1) Else GoTo Fin2
         Else: TIdx(NR) = L2: N2 = N2 + 1: If N2 <= UBound(TFus2) Then L2 = TFus2(N2) Else Exit Do
            End If
         Loop
      Do: NR = NR + 1: TIdx(NR) = TFus1(N1): N1 = N1 + 1: Loop Until N1 > UBound(TFus1): GoTo FusS
Fin2: Do: NR = NR + 1: TIdx(NR) = TFus2(N2): N2 = N2 + 1: Loop Until N2 > UBound(TFus2)
FusS: Loop
   Exit Sub
   Dim Arg As Long, C As Long
Comparer:
   For Arg = 1 To ArgMax: C = TCols(Arg)
      Comp = VarComp(TDon(L2, C), TDon(L1, C), TSens(Arg))
      If Comp Then Return
      Next Arg
   Comp = Sgn(L2 - L1): Return
   End Sub
Private Sub InterpréterParam(ByVal ColOrd As Variant, ByVal UBnd2 As Long, ByVal Pour As String)
   Dim P As Long, N As Long
   Call RàZArguments
   For P = LBound(ColOrd) To UBound(ColOrd)
      If IsArray(ColOrd(P)) Then
         For N = LBound(ColOrd(P)) To UBound(ColOrd(P)): AjoutArgument ColOrd(P)(N), UBnd2, Pour: Next N
      Else: AjoutArgument ColOrd(P), UBnd2, Pour: End If
      Next P
   If RupMax > ArgMax Then RupMax = ArgMax
   End Sub

patricktoulon · 24 Octobre 2023

re
au premier regard c'est ni plus ni moins que le quicksort il y a même une partie qui ressemble à bulle
sauf que tu sépare le compare valeur (x) et valeur (x+1)
puré c'est obscure comme code
puré j'ai perdu un œil dis donc
un peu comme une part de tarte sans bord tu sais pas par quel bout l'attaquer

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

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc