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]

pourquoi tu m'agresse à p'tit vieux ta de l’arthrite?
je parle juste avec dudu2 des blancs voir bugs dans les fonctions native
pète un coup ça ira mieux

 

[p'tit vieux]

pourquoi tu m'agresse à p'tit vieux ta de l’arthrite?
je parle juste avec dudu2 des blancs voir bugs dans les fonctions native
pète un coup ça ira mieux

Je n'agresse pas... J'explique
Là je suis gentil.
Et pour l’arthrite ben oui et autres problèmes de rouille.
Çà rend grincheux par temps humide.

Bonne soirée

 

[Dudu2]

Bonsoir la compagnie des inverseurs de valeurs,

La seule chose est fait elle ce qu'on lui demande bien et aussi vite que possible ?
Le reste c'est du blabla ... Sauf à trouver des bugs ou proposer une/des améliorations fonctionnelles (supplémentaires ?)

Je suis bien d'accord avec ça.
Des solutions concrètes, des propositions et des corrections si besoin de corriger des bugs dans une approche positive, constructive et collaborative.
Les critiques récurrentes systématiquement négatives de la production des autres qui induisent des justifications incessantes c'est désagréable et non productif. C'est du vent.

 

[Dudu2]

Bonjour les retourneurs de cases,
J'ai encore modifié le fichier du Post #212 pour être plus "carré" dans les commentaires relatifs au paramètre LikeExcel. C'est mon coté perfectionniste et itératif qui vous créé ces problèmes de récupérations multiples (pour ceux qui sont intéressés) , désolé.

Edit: Et encore pour simplifier le tableau des paramètres de test de la fonction

 

[Dudu2]

Bonsoir les Maîtres du salto arrière des cellules volantes,

@p'tit vieux a trouvé un bug

(ce qui est quand même un exploit vu que c'est moi qui ai fait le code

en toute modestie comme d'hab !

).
En plus @p'tit vieux m'a obligé à changer le nom de la fonction, vous vous rendez compte ?

Il s'agit de WorksheetFunction.Transpose() qui, sur une valeur, retourne simplement la valeur, ce que mon code initial a raté au niveau du test.

Cette spécificité a eu quelques conséquences un peu plus importantes que prévues et a nécessité de ré-écrire certaines parties et aussi de mettre à jour les commentaires explicatifs.

Ceux qui sont intéressés à la chose peuvent retrouver le fichier modifié en Post #212

 

[p'tit vieux]

Bonsoir les Maîtres du salto arrière des cellules volantes,

@p'tit vieux a trouvé un bug Regarde la pièce jointe 1209105 (ce qui est quand même un exploit vu que c'est moi qui ai fait le code Regarde la pièce jointe 1209106 en toute modestie comme d'hab ! Regarde la pièce jointe 1209107)

Je sens comme une pointe d'ironie si ce n'est du sarcasme là.
Douterais tu de ma capacité à faire planter un code?
C'est que je fais de mieux

En plus @p'tit vieux m'a obligé à changer le nom de la fonction, vous vous rendez compte ? Regarde la pièce jointe 1209108

Comme pour le reste, je ne t'ai pas obligé à rien.
Pour le changement de nom, je crois que je suis encore en capable de le faire. Mais je te l'ai suggéré avec déférence et politesse.

 

[patricktoulon]

Bonjour à tous les deux
ce matin je me suis dit je vais quand même essayer le post 202 (le dernier fichier fourni par @Dudu2)
je l'ai donc ouvert et glisser son module(Module_Transpose2D)dans mon fichier histoire d'avoir tout à portée de main
dans mon fichier j'ai fait un petit tableau dans le quel je vais paramétrer la creation d'un tableau 2D avec des valeurs afin de faire les tests avec des valeurs la fonction générer_table
voici ce petit tableau

je vais donc créer un table(1 to 50000, -2 to 100)
ensuite avec ma version TransposeXV3 je transposerais
et je vais transposer avec des nouvelles bases qui sont -5 pour la première dimension du tableau original et 7 pour la 2d dimension du tableau original
je dois donc à l'arrivée me retrouver avec un tableau transposé
T2(7 to 109 ,-5 to 49994)

j'ai donc ajout un bouton pour tester la fonction de @Dudu2
et je fait dans sa macro affectée le même appel qu'avec ma version 3
voici l'appel pour DUDU2

Sub test_V_DUDU2()
    Dim Avant, TiM#
    Set Rng2 = Range("tb_newbase")
    générer_table
    Avant = "Tests Version DUDU" & vbCrLf & "avant t(" & LBound(t) & " To " & UBound(t) & ", " & LBound(t, 2) & " To " & UBound(t, 2) & ")" & vbCrLf
    TiM = Timer
    Tf = Transpose2D(t, NewBase1, NewBase2)  'avec les nouvelles bases pour T donc tf sera tf(5 to x,-2 to y)
    TiM = (Timer - TiM) * 1000
   
    MsgBox Avant & vbCrLf & "Après tf(" & LBound(Tf) & " To " & UBound(Tf) & " , " & LBound(Tf, 2) & " To " & UBound(Tf, 2) & vbCrLf & vbCrLf & "Avec timer VBA *1000 :" & Round(TiM, 3) & " ms"
   
    MsgBox "contrôle de cohérence" & vbCrLf & "t(" & UBound(t) & ", " & UBound(t, 2) & ") = " & t(UBound(t), UBound(t, 2)) & vbCrLf & _
            "tf(" & UBound(Tf) & ", " & UBound(Tf, 2) & ") = " & Tf(UBound(Tf), UBound(Tf, 2))
End Sub

et voici l'appel pour ma version 3

Sub test_V_3()
    Dim Avant, TiM#
    Set Rng2 = Range("tb_newbase")
    générer_table
    Avant = "Tests TransposeXV3" & vbCrLf & "avant t(" & LBound(t) & " To " & UBound(t) & ", " & LBound(t, 2) & " To " & UBound(t, 2) & ")" & vbCrLf
    TiM = Timer
    Tf = TransposeXV3(t, NewBase1, NewBase2) 'avec les nouvelles bases pour T donc tf sera tf(5 to x,-2 to y)
    TiM = (Timer - TiM) * 1000
   
    MsgBox Avant & vbCrLf & "Après tf(" & LBound(Tf) & " To " & UBound(Tf) & " , " & LBound(Tf, 2) & " To " & UBound(Tf, 2) & vbCrLf & vbCrLf & "Avec timer VBA *1000 :" & Round(TiM, 3) & " ms"
   
    MsgBox "contrôle de cohérence" & vbCrLf & "t(" & UBound(t) & ", " & UBound(t, 2) & ") = " & t(UBound(t), UBound(t, 2)) & vbCrLf & _
            "tf(" & UBound(Tf) & ", " & UBound(Tf, 2) & ") = " & Tf(UBound(Tf), UBound(Tf, 2))
End Sub

comme vous pouvez le constatez c'est le nom de la fonction appelée qui change tout le reste es pareil
et dans les msgbox je me sert des lbound et ubound pour écrire le message

et bien testons voir

test pour dudu2

bon ben ça m'a l'air parfait ça
control de cohérence message suivant

bon ben ça m'a l'air parfait tout ca
509 ms pour 50000 sur 100
on est un peu au dessus de nos première version mais avec tout ce qui a été ajouté on va dire que c'est bien

testons voir ma version 3
ma version 3 c'est la version 2 qui a été modifiée dans ces argument
c'est a dire que mes argument lBase1 et lBase2 ne ramenne plus les bases a 0 ou 1 mais comme celle de dudu2 donne la possibilité de descendre dans le negatif et inversement
et nous allons faire ce test avec les mêmes données que le test effectué avec la version de @Dudu2

bon ben c'a m'a l'air pareil le resultat est bon
sauf que j'ai quand même quasiment 80 ms de moins
voyons voir le controle de cohérence

bon ben c'est sans surprise on est bon

et voila le code de ma fonction
et pour tout vous dire le fait d'être parti sur un changement de base au choix n'a fait qu'en réduire le code

'VERSION 3 LES BASE SONT PARAMETRABLES
'Algoritmi Divide ut imperes = divide and conquer algorithm
 'Lbase1 et lBase2 ne sont plus les repositionneur de base mais deviennent les nouvelles bases
Function TransposeXV3(t, Optional lBase1& = 0, Optional lBase2& = 0)
    'Ajout du change base V 1.2.1 -- 08/12/2024
    'patricktoulon    V 1.4 -- 13/12/2024
    'version 1.3 avec un select case
       Dim y&, i&, C&, T2(), x&, q&
    If TypeOf t Is Range Then If t.Areas.Count = 1 Then t = t.Value Else TransposeXV3 = t: Exit Function
    If Not IsArray(t) Then TransposeXV3 = t: Exit Function
    If IsEmpty(t) Then TransposeXV3 = t: Exit Function
    On Error Resume Next
    y = UBound(t, 2)
    Select Case True
        Case Err
            ReDim T2(lBase1 To UBound(t) - LBound(t) + lBase1, lBase1 To Ubd1)
            For i = LBound(t) To UBound(t): T2(lBase2 + x, lBase1) = t(i): x = x + 1: Next
            On Error GoTo 0
        Case Else
            ReDim T2(lBase2 To UBound(t, 2) - LBound(t, 2) + lBase2, lBase1 To UBound(t) - LBound(t) + lBase1)
            For i = LBound(t) To UBound(t)
                For C = LBound(t, 2) To UBound(t, 2): T2(lBase2 + q, lBase1 + x) = t(i, C): q = q + 1: Next
                    x = x + 1
                    q = 0
                Next
            End Select
        TransposeXV3 = T2
    End Function

en ce qui concerne le "like excel" comme je n'y adhère pas je ne l'ai pas fait mais c'est 2 lignes de plus
et si vous voulez je vous les donnes
juste pour info avec un dim t(1to 100000,1 to 100 je suis à 835 ms
je dépose le fichier qui a servi a faire cette démo
vous vouliez du productif , collaboratif , des propositions
messieurs vous êtes servis
et je suis resté fidèle a ma vision des choses et ma version initiale et ma façon de coder

Patrick

 

[patricktoulon]

juste une petite correction comme j'ai supprimé la variabilisation inutile puisque les calculs sont fait qu'une fois lors du redim
j'avais laisser une variable pour le 1D
correction:

 Case Err
            ReDim T2(lBase1 To UBound(t) - LBound(t) + lBase1, lBase1 To UBound(t))

 

[Dudu2]

Bonjour @patricktoulon,

messieurs vous êtes servis
et je suis resté fidèle a ma vision des choses et ma version initiale et ma façon de coder

C'est vrai que tu as fourni une solution avec un fichier et c'est très bien !
Et c'est vrai aussi que ton code va plus vite que le mien.
Mais est-ce que tu sais pourquoi ? Moi oui ! Et ça n'a rien à voir avec les boucles.

Benchmark en l'état:

Benchmark cause identifiée:

Ceci dit, involontairement, tu m'as apporté un enseignement sur le VBA que je vais mettre à profit pour améliorer le dernière version de Transpose2D.

Et je vais toujours un poil plus vite car il y a encore des calculs dans tes indiçages que tu pourrais d'ailleurs éviter.

 

[Dudu2]

Messieurs les Renverseurs de Tables,
Fort de l'enseignement involontairement fourni par @patricktoulon que je remercie pour ça au passage, j'ai modifié le fichier du Post #212 pour y inclure le bénéfice. Et c'est vraiment pinuts, à peine visible mais ça influe de façon relativement importante sur la performance !

 

[patricktoulon]

Bonjour @Dudu2
je n'ai pas utilisé le benchmark mais simplement le timer de vba pour que les tests soient équitables
même si il y a un effet de bord mais on le subit tout les deux

en fait je vais plus vite car je ne variabilise pas inutilement

le redimensionnement ne doit être fait qu'une fois on est d’accords

pour le 1D
ReDim T2(lBase1 To UBound(t) - LBound(t) + lBase1, lBase1 To UBound(t))

pour le 2D
ReDim T2(lBase2 To UBound(t, 2) - LBound(t, 2) + lBase2, lBase1 To UBound(t) - LBound(t) + lBase1)

terminé j'ai mon tableau final

bon nous avons une 2eme détail qui nous différencie aussi
toi tu considère les argument base1 et base2 comme celle du tableau final
alors que moi lbase 1 et lbase 2 sont les nouvelles base du tableau initiale
que j'inverse uniquement dans le redim
mais ce n'est qu'un détail

c'est quoi le truc que je t'ai apporté involontairement ?

 

[Dudu2]

en fait je vais plus vite car je ne variabilise pas inutilement

Je te l'ai dit, ça n'a rien à voir avec ça. Tu n'y es pas. La cause est ailleurs et je te laisse chercher.

Corrigée (le fichier du Post #212), cette cause rend les codes à peu près équivalents sauf, comme je l'ai déjà dit, que Transpose2D va en moyenne un chouia plus vite car tes indices sont encore calculés ce qui peut être très simplement évité.

 

[patricktoulon]

testé le nouveau tu repasse en tête de 5 à 10 ms

 

[patricktoulon]

ben je ne vois pas on fait la même chose
toi

jtt = LB2
            For it = LBound(t, 1) To UBound(t, 1)
                itt = LB1
                For jt = LBound(t, 2) To UBound(t, 2)
                    tt(itt, jtt) = t(it, jt)
                    itt = itt + 1
                Next jt
                jtt = jtt + 1
            Next it

moi

For i = LBound(t) To UBound(t)
                For C = LBound(t, 2) To UBound(t, 2): T2(lBase2 + q, lBase1 + x) = t(i, C): q = q + 1: Next
                    x = x + 1
                    q = 0
                Next

d'ailleurs rien que la pour moi la logique c'est que LB1 ET JTT sont en fait baseout1 et baseout2 au depart
tu les a direct au départ me semble t il non
quoi je ne sais pas il faut tester
apres si c'est pas ça je ne sais pas

 

[Dudu2]

Sauf si tu changes ta boucle pour ne pas avoir d'indice calculé:

x = lBase1
            For i = LBound(t) To UBound(t)
                q = lBase2
                For C = LBound(t, 2) To UBound(t, 2): T2(q, x) = t(i, C): q = q + 1: Next
                x = x + 1
            Next

Ça sert à rien de promener lBase1 et lBase2 dans la boucle vu que ce sont des valeurs fixes.