XL 2021 Vos avis SVP: Une fonction TRANSPOSE() à améliorer

[p'tit vieux]

Bonjour à tous,
Pour mes codes VBA, j'ai écris une première version de ma fonction Transpose() que je vais mettre à votre disposition dans sa version 1.0.0.
Toutefois, je voudrais votre avis sur l'intérêt de rajouter des options complémentaires à celle-ci.

Dans un premier temps j'ai écris une fonction Transpose() afin de lever la limite des 65536 lignes de la fonction "WorkSheetFunctions.Transpose" d'Excel.
Pour mes besoins j'ai ajouté les possibilités suivantes:
- Choisir la base départ du tableau (Base 0 ou 1)
- Pouvoir convertir un texte/valeur simple dans un tableau 2D T(1,1)

Rien d'exceptionel, mais pratique.

Donc je vous propose de me soumettre vos idées.

Par exemple, j'ai pensé à:
- Si on transmet T(0 to 0, 0 to N) ou T(1 to N, 1 to 1) Transpose() renvoie un tableau 1D T(0 to N) ou T(1 to N) suivant la base choisie
- Transposer ET ne renvoyer que les n premieres lignes
- Transposer ET ne renvoyer de la ligne n° X à n° Y

Voilà pour ces quelques idées.
A votre avis laquelle ou lesquelles de celles-ci ont-elles un intérêt.

Et vous, vos autres idées qui vous paraitraient utiles?
Ensuite suivant vos propositions ….
Je nommerai un 1er Ministre du développement
Mais non! Je publierai une nouvelle version (Pas sérieux ces P'tit Vieux)

Merci pour vos avis et suggestions.

ATTENTION!
Ici il n'est pas question de faire des recherches de texte/valeur ou autre truc du genre.

 

[patricktoulon]

et dire que depuis hier midi je test son fichier de long en large

depuis 3................minutes je n'arrive pas a arrêter de m’éclater de rire
et moi je cherche depuis hier hahahahaha

 

[Dudu2]

Bonjour,
Il y a effet un effet 1er exécuté qui est pénalisant.
Je n'arrive pas à le neutraliser pour le moment.
Ce qui veut dire que le Application.Transpose() est tout à fait comparable aux fonctions VBA et pas du tout plus long.

 

[patricktoulon]

re ben non il est pas pénalisant au contraire justement sauf que c'est faux
car si j’enlève le ticcount freq de debut a celui de la fin ben le premier est champion du monde
et c'est normal c'est comme le timer qui donne l'actu mais les prochains tours tu fait pas l'addition puis soustraction du premier tu a toujours ton temps +le relica du du premier
c'est pas une incidence c'est une erreur (erreur qui est pour "changer" base 1 ou 0 )
ensuite
dis moi @Dudu2 ma fonction elle s'appelle comment ?

 

[patricktoulon]

hier je me suis inspiré de @mapomme avec son select case
en effet on le sait que une fois le case trouvé les autres cases sont occultés
j'ai donc remplacé les if then par un select case dans ma fonction
et en effet je gagne (pas grand chose) certes mais tout de même
LES DEUX VERSIONS

'VERSION 1
Function TransposeXV1(T, Optional lBase& = -1)
    'patricktoulon    V 1.2 -- 08/07/2021
    'Ajout du change base V 1.2.1 -- 08/12/2024  méthode Addition nombre relatif
    Dim y&, i&, c&, T2(), LB1%, LB2%
    If lBase > 1 Then lBase = 1 ' au cas ou il vous prendrez l'envie de faire nimporte quoi
    On Error Resume Next
    y = UBound(T, 2)
    On Error GoTo 0
    'b1 et b2 deviendront les reducteurs ou augmenteur de dimension (++/+-)
    If lBase > -1 Then LB1 = Sgn(lBase - LBound(T))
    If y = 0 Then
        ReDim T2(LBound(T) + LB1 To UBound(T) +LB1, LBound(T) + LB1 To LBound(T) + LB1)
    Else
        If lBase > -1 Then LB2 = Sgn(lBase - LBound(T, 2))
        ReDim T2(LBound(T, 2) + LB2 To UBound(T, 2) + LB2, LBound(T) + LB1 To UBound(T) + LB1)
    End If
    For i = LBound(T) To UBound(T)
        If y = 0 Then
            T2(i + LB1, 1) = T(i)
        Else
            For c = LBound(T, 2) To UBound(T, 2)
                T2(c + LB2, i + LB2) = T(i, c)
            Next
        End If
    Next
    TransposeXV1 = T2
End Function

'VERSION 2
Function TransposeXV2(T, Optional lBase& = -1)
    'Ajout du change base V 1.2.1 -- 08/12/2024  méthode Addition nombre relatif en select case
   'patricktoulon    V 1.3 -- 10/12/2024
    'version 1.3 avec un select case
    Dim y&, i&, c&, T2(), LB1%, LB2%
    If TypeOf T Is Range Then T = T.Value
    If lBase > 1 Then lBase = 1 ' au cas ou il vous prendrez l'envie de faire nimporte quoi
    On Error Resume Next
    y = UBound(T, 2)

    'b1 et b2 deviendront les reducteurs ou augmenteur de dimension (++/+-)

    Select Case True
        Case Err.Number <> 0
            If lBase > -1 Then LB1 = Sgn(lBase - LBound(T))
            ReDim T2(LBound(T) + LB1 To UBound(T) +LB1, LBound(T) + LB1 To LBound(T) + LB1)
            For i = LBound(T) To UBound(T): T2(i + LB1, 1) = T(i): Next
            On Error GoTo 0
        Case Else
            If lBase > -1 Then LB2 = Sgn(lBase - LBound(T, 2))
            ReDim T2(LBound(T, 2) + LB2 To UBound(T, 2) + LB2, LBound(T) + LB1 To UBound(T) + LB1)
            For i = LBound(T) To UBound(T)
                For c = LBound(T, 2) To UBound(T, 2): T2(c + LB2, i + LB2) = T(i, c): Next
            Next
    End Select
    TransposeXV2 = T2
End Function

 

[patricktoulon]

D'ailleurs l'erreur que fait dudu2 prouve bien et démontre bien l'erreur dans le benchmark
la maintenant peut être que l'erreur va être trouvé

 

[patricktoulon]

En fait c'est plus insidueux que ça
a l'examen du code du benchmark
comme quoi des fois hier je pensait avoir bien déterminer l'erreur mais ce n'est pas tout a fait ça
en fait le suivant est impacté du du gettickcount du début du précédent et oui j'ai négligé qu'il allaient par paire

l'erreur provient du fait qu'il utilise plusieurs dictionnaires Id /track/etc...
et dans ces boucles de report quand il compile il y a une erreur d'index
ça va être difficile justement car il y a un soucis avec une option intégré a savoir la compil dans un même index de dico pour les track identiques

Alors @Dudu2 tu a trouvé ton erreur ou pas ?

 

[patricktoulon]

pour palier au petit soucis faire un track(debut/fin) avec rien entre chaque tests avec un trackname différent bien entendu sinon il seront compilé dans la première occurrence
au pire on aura un erreur de 1 à 15µs

voila vous savez tout

 

[jurassic pork]

Hello,
c'est un peu l'usine à gaz votre utilisation du bm avec des débuts et des fins. Il y a plus simple . Par exemple pour le programme de dudu2 en mettant ceci dans la procédure Test :

Set Tbl2 = ActiveSheet.ListObjects("Tableau2")
    GoSub InitTable  
    bm.Start
    tt = TransposeNaturel(t)
    bm.TrackByName "TransposeNaturel"
    bm.Pause
    GoSub InitTable
    bm.Continue
    tt = Application.Transpose(t)
    bm.TrackByName "Transpose"
    bm.Pause
    GoSub InitTable
    bm.Continue
    tt = TransposeNaturel(t)
    bm.TrackByName "TransposeXV1"
    bm.Pause
    GoSub InitTable
    bm.Continue
    tt = TransposeBaseUn(t)
    bm.TrackByName "TransposeBase1"
    Exit Sub

Voici ce que j'obtiens :

IDnr	Name	Count	Sum of tics	Percentage	Time sum
0​	TransposeNaturel	1​	4 139 956	21,77%	414 ms
1​	Transpose	1​	6 510 441	34,24%	651 ms
2​	TransposeXV1	1​	4 175 250	21,96%	418 ms
3​	TransposeBase1	1​	4 190 088	22,03%	419 ms
	TOTAL	4​	19 015 735	100,00%	1,9 s

 

[patricktoulon]

bonjour @jurassic pork
bon ben au moins tu teste vraiment ma fonction toi

 tt = TransposeNaturel(T)
    bm.TrackByName "TransposeXV1"
    bm.Pause

incroyable il y en a un qui fait une shbounss et tout les moutons de panurge qui suivent
c'est formidable

 

[jurassic pork]

En fait je faisais semblant de tester ta fonction. Après correction :

tt = TransposeXV1(t)
    bm.TrackByName "TransposeXV1"

IDnr	Name	Count	Sum of tics	Percentage	Time sum
0​	TransposeNaturel	1​	4 148 204	22,04%	415 ms
1​	Transpose	1​	6 385 288	33,92%	639 ms
2​	TransposeXV1	1​	4 122 341	21,90%	412 ms
3​	TransposeBase1	1​	4 166 753	22,14%	417 ms
	TOTAL	4​	18 822 586	100,00%	1,88 s

et faites une bonne utilisation du cBenchmark comme dans mon message précédent (avec les start pause et continue).Le TrackByName s'applique à ce qui précède et pas à ce qui suit.

 

[Dudu2]

Selon le mode d'appel (Application.Run ou Direct Call) ça varie.

Application.Run:
- Le premier s'en prend plein la tête (un effet du Application.Run que je n'arrive pas à inhiber)
- Le Application.Transpose est tout à fait performant

Direct Call:
- Pas de pénalisation du 1er
- Le Application.Transpose devient moins performant

Ce truc de Benchmark, ben je vais simplement l'abandonner au profit du Timer, certes lui aussi peu précis mais simple et malgré tout représentatif.

 

[patricktoulon]

en effet les temps sont plus justes et correspondent à 1/20 µs près au timer
je vais tester les fonctions dans des ordres différent pour voir
@jurassic pork
il fallait simplement mettre le start pour eviter l'erreur de 1 item

 

[Dudu2]

Bonjour @jurassic pork,
Les Tags/Names de Début et Fin c'est pour encadrer strictement l'appel de la fonction.
Sinon tu comptes les manip faites entre-temps.
Je pense qu'il ré-initialise les compteurs à chaque Tag/Name et les cumule pour des Tags/Names identiques répétés.

 

[Dudu2]

Ce truc de Benchmark, ben je vais simplement l'abandonner au profit du Timer, certes lui aussi peu précis mais simple et malgré tout représentatif.

En fait c'est pas judicieux ce que je dis là.
Y a des raisons et il faut les trouver.

 

[patricktoulon]

bon apres test dans le désordre effectivement ce n'est pas cohérent
le suivant est impacté par le précédent
il faut donc bien créer des test même vides intermediaire
test avec start et pause et continue
ordre 1

test ordre 2

j'yrais pas plus loin
ou alors instancier autant de classe que de tests (ce qui n'a plus de sens bien sur) même si effectivement ca fonctionne