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

RyuAutodidacte · 1 Novembre 2023

Re,
Avant d'aller plus loin, j'aimerai éclaircir un point sur la fameuse limitation des 65 536 …

A qui s'applique cette limitation pour les fonctions VBA et sur quelle version d'Excel ?

Sur les fonctions :
1. Application.Transpose
2. Application.Index
3. Application.Match
4. autres ? … à ajouter si nécessaires, qui vous viendrez à l'esprit …

Sinon je me suis un peu fourvoyez en voulant minimiser les boucles via join et split pensant que c'était plus rapide, après test voilà ce qu'il en est … cf codes
Le résultat est sans appel application.Match ou la boucle … il est sur que je reverrai ma copie …

Code pour générer les nombres aléatoires sans doublons :

VB:

Sub RandomNumbersUnique()
Dim C As New Collection, N, lowerbound As Integer, upperbound As Long
    lowerbound = 1
    upperbound = 500000
    ReDim N(lowerbound To upperbound, 1 To 1)
    On Error Resume Next
    For i = lowerbound To upperbound
        RandomNumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        C.Add RandomNumber, CStr(RandomNumber)
        If Err Then
            Do While Err
                Err.Clear
                RandomNumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
                C.Add RandomNumber, CStr(RandomNumber)
            Loop
        End If
        N(i, 1) = RandomNumber
    Next
    Application.ScreenUpdating = False
    Cells(1).Resize(upperbound).Value = N
    Application.ScreenUpdating = True
End Sub

Les codes tests de recherche :

VB:

Sub testMatch()
    VA = Cells(1).CurrentRegion.Value
    Valeur = Cells(499993, 1).Value
    T = Timer
    C = Application.Match(Valeur, VA, 0)
    MsgBox Timer - T & " pour rechercher " & Valeur & " se trouvant sur la ligne " & C
End Sub

Sub Boucle()
    Valeur = Cells(499993, 1).Value
    VA = Cells(1).CurrentRegion.Value
    T = Timer
    For i = 1 To UBound(VA)
        If VA(i, 1) = Valeur Then
            C = i
            Exit For
        End If
    Next
    MsgBox Timer - T & " pour rechercher " & Valeur & " se trouvant sur la ligne " & C
End Sub

Sub BoucleArray1D()
    Valeur = Cells(499993, 1).Value
    VA = Cells(1).CurrentRegion.Value
    ReDim V(1 To UBound(VA))
    For i = 1 To UBound(VA):    V(i) = VA(i, 1):    Next
    T = Timer
    For i = 1 To UBound(VA)
        If V(i) = Valeur Then
            C = i
            Exit For
        End If
    Next
    MsgBox Timer - T & " pour rechercher " & Valeur & " se trouvant sur la ligne " & C
End Sub

Sub UboundSplitJoin()
    Valeur = Cells(499993, 1).Value
    VA = Cells(1).CurrentRegion.Value
    ReDim V(1 To UBound(VA))
    For i = 1 To UBound(VA):    V(i) = VA(i, 1):    Next
    T = Timer
    C = UBound(Split(Split(Join(V, "|"), Valeur & "|")(0), "|")) + 1
    MsgBox Timer - T & " pour rechercher " & Valeur & " se trouvant sur la ligne " & C
End Sub

RyuAutodidacte · 1 Novembre 2023

Hello @patricktoulon

patricktoulon à dit:
d'ailleurs en 5/6 phrases ( ca ne devrait pas demander plus)serais tu capable de m'expliquer le fonctionnement de base( add cle item) sans tout tes à coté

Comme je l'ai fait Item clé mais c'est du pareil au même pour clé item voilà en peu de phrase ce que cela donne pour Add clé item …

PS : je viens de découvrir en tout cas sur mon Excel Office 365, que la limitation dont je parlais de 65 536 existe sur Application.Match sur un tableau 1D, mais pas un tableau 2D et là j'hallucine
Post# 256 ou personne n'a répondu

Bon sinon en reprenant ce que je disais su mon poste au dessus :

RyuAutodidacte à dit:
il est sur que je reverrai ma copie …

Voilà ce qu'il en est (sans version tableau se construisant dans la foulée tel sur mon 1er module de classe) :

Dans un module de classe, j'utilise une collection pour insérer clé/item ou chaque item contient un tableau 1D de 0 to 1 => 0 pour les clés et 1 pour les items ou Objets (prochaine phase), bien sur je reprends la clé en 0 pour la clé. Je garde le principe de l'indice de la collection et le before et after d'une collection.
Dans le cas ou la clé existe j'ai ajouté les options OverWrit et AddItemToKey (cumule). Pour cela je récupère les valeurs de la clé (Tb 0 to 1) et l'indice via une boucle, je remove la clé et réinsère au meme endroit la clé soit en changeant la valeur soit en la cumulant avec le séparateur "µ"

Ce qui donne ce qui suit en code puisque réécrit pour la partie de base
avec le nom pour le module de classe cDic :

VB:

Option Explicit
Option Compare Text

Private Coll As Collection
'Private objTab
'Private Const Sep As Integer = 167 ' <= § avec ChrW - MAC/PC
Private Const SepItm As Integer = 181 ' <= µ avec ChrW - MAC/PC

Public Sub Add(KeyC, ItemC, Optional Before, Optional After, Optional OverWrit As Boolean, Optional AddItemToKey As Boolean)
Dim objCol, GetObjColl, C As Long, i As Long, Indice As Long

    If Coll Is Nothing Then Set Coll = New Collection: ' If Coll.Count = 0 Then C = 1 Else C = Coll.Count + 1
    ReDim objCol(0 To 1):     objCol(0) = CStr(KeyC):       objCol(1) = ItemC
   
    On Error Resume Next
    Coll.Add objCol, objCol(0), Before, After
   
    If Err Then
    Err.Clear:          GetObjColl = Coll(objCol(0))
        For i = 1 To Coll.Count
            If Coll(i)(0) = GetObjColl(0) Then Indice = i: Exit For
        Next
        If OverWrit Then Coll.Remove GetObjColl(0):      Coll.Add objCol, GetObjColl(0), Indice
        If AddItemToKey Then Coll.Remove GetObjColl(0):      objCol(1) = GetObjColl(1) & ChrW(SepItm) & ItemC:      Coll.Add objCol, GetObjColl(0), Indice
    End If

End Sub

toto	45
titi	12
U3	Usine3
riri	27
fifi	85
NEW toto	45

Pour le test :

VB:

Sub TestLaBase_cDic()
Dim DicoC As New cDic, VA

    VA = ActiveSheet.Cells(1).CurrentRegion.Value
    For i = 1 To UBound(VA)
        DicoC.Add VA(i, 2), VA(i, 1), , , True
    Next
    Stop
End Sub

patricktoulon · 1 Novembre 2023

Bonjour
A enfin un code intelligible
bon alors on a compris le principe( d'ailleurs déjà vu et cité par Dranreb précédemment )
donc tu a adopté le principe
l'item contient la cle et l'item sous la forme d'un array
la clé contient la cle

dans l'array de l'item constitué donc des deux elements (key/item )
la possibilité similaire a mon model cumulate tu la fait en mettant un caractères de separation dans l'item(1) de l'array dans l'item ( si je puis m'exprimer ainsi )
ce qui explique ton besoins de découpage dans la fonction sort car due au fait que l'on a pas le moyen de lister les clés(a part avec l'api Rtlmovememory) il nous fallait bien les lister

bon ok
je m'attendais a une nouvelle méthode
en tout cas on vois que tu comprends mieux le principe des classes et collection
honnêtement je préfère de loin et même de très loin ta version de base ( avec on comprend très vite l'intention

RyuAutodidacte · 1 Novembre 2023

Re

j'ai retiré le tableau qui se construisait en même temps qui me permettait un accès direct pour des routines du module de classe.

patricktoulon à dit:
bon alors on a compris le principe( d'ailleurs déjà vu et cité par Dranreb précédemment )

je me suis inspiré d'un post qui n'était pas sur XLD

Sinon tu as un avis sur ce que je disais sur les limitations et sur quelle version d'Excel ?

RyuAutodidacte · 1 Novembre 2023

patricktoulon à dit:
ce qui explique ton besoins de découpage dans la fonction sort

le découpage se faisait entre l'item et la clé, schématiquement on avait :
ITEMseparateurCLE => ITEM§CLE via mon tableau objTab dans le module de classe du code de la base

patricktoulon · 1 Novembre 2023

re
a première vu c'est bon mais ca ne l'est pas
regarde dans la property keys
pour le nom de la clé j'utilise coll(i)(1) et l(item coll(i)(0)

alors que quand on le entre dans le dico

VB:

 objCol = Array(CStr(KeyC), ItemC)

    On Error Resume Next
    Coll.Add objCol, objCol(0), Before, After

là j'ai pas pigé un truc

VB:

Private Coll As Collection
'Private objTab
'Private Const Sep As Integer = 167 ' <= § avec ChrW - MAC/PC
Private Const SepItm As Integer = 181    ' <= µ avec ChrW - MAC/PC

Public Property Get Keys(Optional clé As String = "")
    Dim T, I&
    If clé = "" Then
        ReDim T(1 To Coll.Count): For I = 1 To Coll.Count: T(I) = Coll(I)(1): Next: Keys = T
    Else
        For I = 1 To Coll.Count
            If Coll(I)(1) = clé Then Keys = Coll(I)(0): Exit Property
        Next
    End If
End Property

Public Property Get Items()
    Dim T, I&
    ReDim T(1 To Coll.Count): For I = 1 To Coll.Count: T(I) = Coll(I)(0): Next
    Items = T
End Property

Public Sub Add(KeyC, ItemC, Optional Before, Optional After, Optional OverWrit As Boolean, Optional AddItemToKey As Boolean)
    Dim objCol, GetObjColl, C As Long, I As Long, Indice As Long

    If Coll Is Nothing Then Set Coll = New Collection:    ' If Coll.Count = 0 Then C = 1 Else C = Coll.Count + 1
    objCol = Array(CStr(KeyC), ItemC)

    On Error Resume Next
    Coll.Add objCol, objCol(0), Before, After

    If Err Then
        Err.Clear: GetObjColl = Coll(objCol(0))
        For I = 1 To Coll.Count
            If Coll(I)(0) = GetObjColl(0) Then Indice = I: Exit For
        Next
        If OverWrit Then Coll.Remove GetObjColl(0): Coll.Add objCol, GetObjColl(0), Indice
        If AddItemToKey Then Coll.Remove GetObjColl(0): objCol(1) = GetObjColl(1) & ChrW(SepItm) & ItemC: Coll.Add objCol, GetObjColl(0), Indice
    End If

End Sub

VB:

Sub TestLaBase_cDic()
    Dim DicoC As New cDic, VA

    VA = ActiveSheet.Cells(1).CurrentRegion.Value
    For I = 1 To UBound(VA)
        DicoC.Add VA(I, 2), VA(I, 1), , , True
    Next

    k = DicoC.Keys
    it = DicoC.Items

    MsgBox Join(k, ",")

    MsgBox Join(it, ",")

    MsgBox DicoC.Keys("toto")

End Sub

kiki29 · 1 Novembre 2023

Salut, à titre documentaire : Limites et lacunes de VBA

patricktoulon · 1 Novembre 2023

ha non c'est bon
en fait c'est dès le départ tu fonctionne comme une collection e non un dico
DicoC.Add VA(I, 2), VA(I, 1), , , True
c'est ta colonne 2 les clés
ça me perturbe

RyuAutodidacte · 2 Novembre 2023

patricktoulon à dit:
ha non c'est bon
en fait c'est dès le départ tu fonctionne comme une collection e non un dico
DicoC.Add VA(I, 2), VA(I, 1), , , True
c'est ta colonne 2 les clés
ça me perturbe

Re Patrick,
peux importe le sens c'est toi qui choisi quelle colonne sera les clés
mais sur mon code on commence bien par clé puis item et la ca ne te perturbe pas là

patricktoulon · 2 Novembre 2023

re
oui mal ce qui m'a perturbé c'est que les clés c'est val(t(i,2)) et les valeurs val(t(i,1))
sachant que dans ta colonnes 2 il y a des nombres et des mots
et qu'une collection a ces clé automatique numerique si omises
je me vois mal utiliser des nombre
on pourrait par exemple confondre la clé"18" et la clé 18
bon pour le coup j'adhère a ta base sauf que je vais modifier la fonction Add et virer tout ses arguments qui deviendront des property de la classe
un dico n'a pas de fonction add avec before , after, overwrite, ou encore additemkey

RyuAutodidacte · 2 Novembre 2023

patricktoulon à dit:
re
oui mal ce qui m'a perturbé c'est que les clés c'est val(t(i,2)) et les valeurs val(t(i,1))

j'aurais du inversé mes colonnes ca aurait été plus logique

kiki29 à dit:
Salut, à titre documentaire : Limites et lacunes de VBA

Coucou Kiki
Merci le roi du lien

RyuAutodidacte · 2 Novembre 2023

patricktoulon à dit:
on pourrait par exemple confondre la clé"18" et la clé 18

non Patrick une clé est toujours en texte d'ou le Cstr pour insérer un nombre
Tu ne peux pas faire : clé = 18
Par contre tu peux faire : clé = "18" ou Cstr(18)
ce n'est pas la même chose , normalement confusion ne dois pas (yoda sort de ce corps )

Si tu fais MonDico(18) tu appelles l'item par son indice ou index (comme tu veux) en position 18
MonDico(18) via l'index pourrais être égal par exemple à MonDico("TOTO3") via la clé

patricktoulon à dit:
un dico n'a pas de fonction add avec before , after, overwrite, ou encore additemkey

oui un vrai dico mais rappelle toi que j'ai voulu allié ce que peux faire un dico et une collection … c'est voulu … et ma base le fait très bien

patricktoulon · 2 Novembre 2023

VB:

Option Explicit
Option Compare Text

Private Coll As Collection
'Private objTab
'Private Const Sep As Integer = 167 ' <= § avec ChrW - MAC/PC
Private Const SepItm As Integer = 181    ' <= µ avec ChrW - MAC/PC

Public OverWrit As Boolean

Public AddItemToKey As Boolean


Public Property Get Keys(Optional clé As String = "")
    Dim T, I&
    If clé = "" Then
        ReDim T(1 To Coll.Count): For I = 1 To Coll.Count: T(I) = Coll(I)(0): Next: Keys = T
    Else
        For I = 1 To Coll.Count
            If Coll(I)(0) = clé Then Keys = Coll(I)(1): Exit Property
        Next
    End If
End Property

Public Property Get Items()
    Dim T, I&
    ReDim T(1 To Coll.Count): For I = 1 To Coll.Count: T(I) = Coll(I)(1): Next
    Items = T
End Property

Public Sub Add(KeyC, ItemC)
    Dim objCol, GetObjColl, C As Long, I As Long, Indice As Long

    If Coll Is Nothing Then Set Coll = New Collection:    ' If Coll.Count = 0 Then C = 1 Else C = Coll.Count + 1
    objCol = Array(CStr(KeyC), ItemC)

    On Error Resume Next
    Coll.Add objCol, objCol(0)

    If Err Then
        Err.Clear: GetObjColl = Coll(objCol(0))
        For I = 1 To Coll.Count
            If Coll(I)(0) = GetObjColl(0) Then Indice = I: Exit For
        Next
        If OverWrit Then Coll.Remove GetObjColl(0): Coll.Add objCol, GetObjColl(0), Indice
        If AddItemToKey Then Coll.Remove GetObjColl(0): objCol(1) = GetObjColl(1) & ChrW(SepItm) & ItemC: Coll.Add objCol, GetObjColl(0), Indice
    End If

End Sub

Code:

Sub TestLaBase_cDic()
    Dim DicoC As New cDic, VA

    DicoC.OverWrit = True

    VA = ActiveSheet.Cells(1).CurrentRegion.Value

    For I = 1 To UBound(VA)
        DicoC.Add VA(I, 1), VA(I, 2)
    Next

    k = DicoC.Keys
    it = DicoC.Items

    MsgBox Join(k, ",")

    MsgBox Join(it, ",")

    MsgBox DicoC("toto")

End Sub

j'ai inclut la propriété Keys par défaut
voila voila

RyuAutodidacte · 2 Novembre 2023

Re @patricktoulon

Pour infos je me suis basé sur les 17 1ère lignes de ce post sans regarder le reste …

Maintenant que j'ai fait l'essentiel et sorti mon 1er module de classe j'ai pu regarder une partie des posts/fichiers que j'avais zappé pour ne pas être influencé dont ton fameux module de classe avec 2 tableaux.

Si j'avais fait une petite aparté sur les limites c'est par ce que j'avais tiqué sur qq chose dont la gestion des tableaux 1D (je n'avais pas envie d'être limité …)

En regardant ton code j'ai vu que tu utilisais Match sur un tab 1D, le problème, en tout cas sur ma version d'Excel, c'est que Match est limité à 65536 sur un tableau 1D.

Pour ma part c'est qq ch qui ne me convient pas … par contre on dépasse la limite sur un tableau 2D :

VB:

Option Base 1
Sub RandomNumbersUnique()
Dim C As New Collection, N, lowerbound As Integer, upperbound As Long
    lowerbsound = 1
    upperbound = 65537
    ReDim N(lowerbound To upperbound, 1 To 1)
    On Error Resume Next
    For i = lowerbound To upperbound
        RandomNumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        C.Add RandomNumber, CStr(RandomNumber)
        If Err Then
            Do While Err
                Err.Clear
                RandomNumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
                C.Add RandomNumber, CStr(RandomNumber)
            Loop
        End If
        N(i, 1) = RandomNumber
    Next
    Application.ScreenUpdating = False
    Cells(1).Resize(upperbound).Value = N
    Application.ScreenUpdating = True
End Sub

Sub MatchArray1DLimite_NOK()
Dim V(), C
    Valeur = Cells(65537, 1).Value
    VA = Cells(1).CurrentRegion.Value
    ReDim V(1 To UBound(VA))
    For i = 1 To UBound(VA):   V(i) = VA(i, 1):    Next
    T = Timer
    C = Application.Match(Valeur, V, 0)
    If IsError(C) Then
        MsgBox "Nous avons une erreur " & "2042" & vbNewLine & "car on a dépassé la limite d'un tab 1D" & vbNewLine & "qui est de 65 536"
    End If
End Sub
Sub MatchArray1DLimite_OK()
Dim V(), C
    Valeur = Cells(65536, 1).Value
    VA = Cells(1).CurrentRegion.Value
    ReDim V(1 To UBound(VA) - 1)
    For i = 1 To UBound(VA) - 1: V(i) = VA(i, 1):    Next
    T = Timer
    C = Application.Match(Valeur, V, 0)
    MsgBox Timer - T & " s pour rechercher " & Valeur & " se trouvasnt sur la ligne " & C
    MsgBox "Donc la limite est bien de 65536 pour un tab de dimension 1D"
End Sub

Sub testMatchTb2D_OK()
    VA = Cells(1).CurrentRegion.Value
    Valeur = Cells(65537, 1).Value
    T = Timer
    C = Application.Match(Valeur, VA, 0)
    MsgBox Timer - T & " pour rechercher " & Valeur & " se trouvant sur la ligne " & C
    MsgBox "Pour un tab de dimension 2D, la limite  65536 est dépassé"
End Sub

Autre chose qui me dérange (vrai ou faux pb ?), c'est d'avoir 'DicoC.OverWrit = True' (ou même pour le cumule) en début de code qui agit de manière globale et non sélective …
Dans une même procédure, il peut y avoir des conditions où l'overwrite et/ou le cumule peuvent s'appliquer ou non selon les cas …

voilà les 2 seules petites remarques que je peux faire

PS : sur ma machine recherche via application.Match est aussi rapide qu'une recherche par boucle d'un tableau 1D (qui lui n'est pas limité et ne provoque pas l'erreur 2042)
Donc si on veut faire une recherche avec application.Match en dépassant la limite de 65536, le faire avec un tableau 2D
Sinon autant passé par une boucle d'un tableau 1D

patricktoulon · 2 Novembre 2023

re
pourquoi tu t'imagine travailler avec un tableau aussi grand toi ?
c'est plus un dictionnaire qu'il te faut la
mais l'idée de la boucle a la place de match n'est pas mauvaise
par contre sur windows variable tableau 1 dim ou 2 dim limite pareille 65536

d'ailleurs selon le type de donnée on va pas jusque à 65536 avec un arry
c'est sur une plage de cellule que la limite s'efface
c'est pas la même chose

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

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

kiki29

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Pièces jointes

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc