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.

 

[job75]

Le point n°1: A quoi sert l'option Base1

La solution que j'ai donnée n'utilise pas cette instruction, prenez le temps de l'étudier SVP.

 

[patricktoulon]

une petite carasbistouille qui peut induire en erreur en effet avec mon code
toi tu fait
ReDim b(Lb1 To Ub1, 0 To 0)
et moi je fait
ReDim b(Lb1 To Ub1, 1)

on pourait croire que je suis en base 1 pour la dim 2 mais il n'en est rien et le ubound donnera zero

 

[p'tit vieux]

La solution que j'ai donnée n'utilise pas cette instruction, prenez le temps de l'étudier SVP.

J'ai vu
Mais l'option Base1 du paramètre est là pour demander de convertir ou d'uniformiser le tableau d'une base vers une autre. Ce n'est là que cela.

 

[p'tit vieux]

j'aurais dû aussi vous dire que j'utilise cette fonction dans d'autre cadre comme l'union de tableaux ou pour d'autres opérations dans lesquelles je manipule des tableaux..
Dans ces cas, j'ai donc besoin (Impératif!) d'uniformiser les bases.
Bon OK. Ca dépasse le cadre Excel.

C'est vrai Patrick j'aurai peut-être pu ou dû scinder les 2 traitements.
Mais dans mes codes, appeler 2 fonctions l'une derrière l'autre pour obtenir le résultat final
… Mooiii fainéant? Qui dit ça?

 

[patricktoulon]

re
ça dépasse rien du tout tu t'y pends mal c'est tout
une solution ça se factorise
on met pas tout dans un shaker en secouant c'est pas un cocktail
on fait des algo pour chaque opérations
j'ai besoin de quoi:

'savoir les dimensions              on fait une fonction

'connaitre le base                  on fait une fonction

'changer le base                    on fait une fonction

'transposer sans limite             on fait une fonction

'merger deux tableaux ou plus       on fait une fonction

c'est comme ça qu'il faut travailler et pas autrement
je te donne rendez vous dans 1 an et on verra si tu sais m'expliquer chaque ligne de ton code

 

[p'tit vieux]

re
ça dépasse rien du tout tu t'y pends mal c'est tout
une solution ça se factorise
on met pas tout dans un shaker en secouant c'est pas un cocktail
on fait des algo pour chaque opérations
j'ai besoin de quoi:

'savoir les dimensions              on fait une fonction

'connaitre le base                  on fait une fonction

'changer le base                    on fait une fonction

'transposer sans limite             on fait une fonction

'merger deux tableaux ou plus       on fait une fonction

c'est comme ça qu'il faut travailler et pas autrement
je te donne rendez vous dans 1 an et on verra si tu sais m'expliquer chaque ligne de ton code

Bonsoir
Désolé mais là je ne peux pas.
Demain je mettrai le code corrigé et ... découpé .
Ça devrait me 1/4 d’heure.max
Le plus long sera de tout commenter le code.

Bonne soirée à tous

 

[Dudu2]

Bonsoir les Transposeurs ,
J'ai un peu raté ce sujet qui a sûrement déjà des réponse et pour info voilà la fonction que j'utilise le plus souvent. Y a vraiment rien de sorcier.

D'ailleurs ça date de 2021 sur cette discussion.

Edit: j'ai supprimé le code car il faut y apporter des petites améliorations qu'on trouvera ci-dessous?

 

[patricktoulon]

Bonjour @
il t'en manque un peu là je crois

 If NbDimensions = 1 Then
        TransposeNaturel = t

donc si T est un array tu transpose pas toi ?


dans ma nouvelle version j'ai séparé le dim 1
pour avoir cette option seule ça peut servir

'FONCTION DE SUBSTITUTION DE LA FONCTION TRANSPOSE DE EXCEL
Function TransposeX(T As Variant) As Variant
    'patricktoulon    V 1.2 -- 08/07/2021
    'remastered by patricktoulon V1.3 -- 06/12/2024
    'déportation du redimensionnement 1D to 2D dans la fonction ConvertTo2Dim
    Dim T2() As Variant, i&, c&, Y&
    On Error Resume Next
    Y = UBound(T, 2)
    On Error GoTo 0
    If Y = 0 Then T = ConvertTo2Dim(T) ' Si t est un tableau 1 Dim, convertir en 2D [[[dans le même sens]]]

    ReDim T2(LBound(T, 2) To UBound(T, 2), LBound(T) To UBound(T)) ' Redimensionner t2 pour transposer t
    For i = LBound(T) To UBound(T)
        For c = LBound(T, 2) To UBound(T, 2): T2(c, i) = T(i, c): Next c
    Next i
    TransposeX = T2 'Return
End Function

'FONCTION DE CONVERSION  D'UN ARRAY VERS TABLEAU 2 DIM
Function ConvertTo2Dim(ByVal T As Variant) As Variant
    'patricktoulon    V 1.0 -- 06/12/2024
    Dim T2(), i&, Y&
    On Error Resume Next
    Y = UBound(T, 2)
    On Error GoTo 0
    If Y > 0 Then ConvertTo2Dim = T: Exit Function
    ReDim T2(LBound(T) To LBound(T), LBound(T) To UBound(T))
    For i = LBound(T) To UBound(T): T2(LBound(T), i) = T(i): Next i
    ConvertTo2Dim = T2
End Function

sinon tu a ma version initiale

Function TransposeX(t)
    'patricktoulon    V 1.2 -- 08/07/2021
    Dim y&, i&, c&, t2
    On Error Resume Next
    y = UBound(t, 2)
    On Error GoTo 0
    If y = 0 Then
        ReDim t2(LBound(t) To UBound(t), 1)
    Else
        ReDim t2(LBound(t, 2) To UBound(t, 2), LBound(t) To UBound(t))
    End If
    For i = LBound(t) To UBound(t)
        If y = 0 Then
            t2(i, 1) = t(i)
        Else
            For c = LBound(t, 2) To UBound(t, 2): t2(c, i) = t(i, c): Next
        End If
    Next
    TransposeX = t2
End Function

le tout en gardant la même base bien entendu

 

[Dudu2]

donc si T est un array tu transpose pas toi ?

Non, je transpose pas, d'ailleurs, le Transpose "naturel" ne devrait concerner que les tableaux à 2 dimensions.

Dans ce lien 2021 sur cette discussion., Il y a aussi une fonction TransposeExcel() qui transpose comme Excel(***) tout en levant la limite des 65535. Je n'ai jamais eu à m'en servir. Je n'aime pas ces suppression / ajout d'une dimension quand elle est de 1, ça perturbe. On ne sait jamais la dimension qu'on perd ou qu'on gagne.

Edit (***) avec une petite erreur que je viens de corriger, 3 ans après

 

[patricktoulon]

re
ben oui souvent un regard neuf et hop!!

Non, je transpose pas, d'ailleurs, le Transpose "naturel" ne devrait concerner que les tableaux à 2 dimensions.

dommage car pourtant la fonction d'excel le fait
le but étant pas de faire différent mais de supprimer la limite
mais tu fait comme tu veux

 

[Dudu2]

Le besoin de transposer vient essentiellement du fait qu'on ne peut faire un Redim que sur la dernière (en général la 2ème) dimensions.

Par exemple on a un tableau (Lignes, Colonnes) dans lequel on veut ajouter des lignes.
Pas de bol, les lignes c'est la 1ère dimension qu'on ne peut pas Redim.
Alors on fait un tableau (Colonnes, Lignes) qu'on peut Redim et à la fin on le transpose naturellement en évitant les modifs de dimensions d'Excel pour rester générique de sorte qu'on peut l'affecter à un Range sans se poser de questions.

C'es pour ça que j'ai appelé la fonction TransposeNaturel().

 

[Dudu2]

Alors, je suis d'accord qu'en cas d'1 seule dimension, c'est peut-être bien d'en ajouter un 2ème de (1 to 1). Ça permet de simuler une colonne de Range.

 

[Dudu2]

Et puisque je suis dans l'élan de poster, une question.
Que faut-il passer en argument et retourner ?
- Un Variant ?
- Une Table de Variant ?

Si le résultat est vide que faut-il tester ?
- Un Variant -> If Retour = Empty then Msgbox "Y a rien" ?
- Une Table de Variant ? If Not (Not Retour) then Else Msgbox "Y a rien" ?

 

[Dudu2]

Avec un test comme ça:

Sub a()
    'Dim t(1 To 1) As Variant
    Dim t() As Variant
    Dim tt() As Variant
 
    tt = TransposeNaturel(t)
    If Not (Not tt) Then MsgBox "Pas vide" Else MsgBox "Vide"
End Sub

Cette fonction est plus juste, car il faut aussi prévoir qu'on reçoit un tableau vide.

'------------------------------------------------------------------
'Transpose "naturel" qui évite la réduction du nombre de dimensions
'lors de l'utilisation de WorksheetFunction.Transpose().
'Cette fonction conserve les 2 dimensions dans tous les cas et
'lève la limite de 65535 items de WorksheetFunction.Transpose().
'------------------------------------------------------------------
Function TransposeNaturel(t As Variant) As Variant
    Dim NbDimensions As Integer
    Dim tt() As Variant
    Dim i As Long
    Dim j As Long
  
    If Not IsArray(t) Then
        MsgBox "Function TransposeNaturel: error argument is not an array !"
        Exit Function
    End If

    '-----------------------------
    '0, 1 ou 2 dimensions pour t ?
    '-----------------------------
    On Error Resume Next
    i = UBound(t, 1)
    If Not Err.Number = 0 Then
        NbDimensions = 0
    Else
        i = UBound(t, 2)
        If Not Err.Number = 0 Then
            NbDimensions = 1
        Else
            NbDimensions = 2
        End If
    End If
    On Error GoTo 0

    '------------------------------
    't est un tableau à 1 dimension
    '------------------------------
    If NbDimensions = 1 Then
        ReDim tt(LBound(t) To UBound(t), 1 To 1)
      
        For i = LBound(t) To UBound(t)
            tt(i, 1) = t(i)
        Next

    '-------------------------------  
    't est un tableau à 2 dimensions
    '-------------------------------
    ElseIf NbDimensions = 2 Then
        ReDim tt(LBound(t, 2) To UBound(t, 2), LBound(t, 1) To UBound(t, 1))
      
        For i = LBound(t, 2) To UBound(t, 2)
            For j = LBound(t, 1) To UBound(t, 1)
                tt(i, j) = t(j, i)
            Next j
        Next i
    End If

    '------------  
    'Return value
    '------------
    TransposeNaturel = tt
End Function

 

[patricktoulon]

je ne sais pas perso j'ai pris parti d'imiter vba et de faire des gestion d'erreur post fonction avec err.raise
par exemple ma fonction JoinSuiteArray

Function JoinSuiteArray(ParamArray q() As Variant) As Variant
    Dim p&, it As Variant, x&, t3() As Variant, h
    For p = LBound(q) To UBound(q)
        If IsArray(q(p)) Then
         

            For Each it In q(p)
                x = x + 1: ReDim Preserve t3(1 To x): t3(x) = it
            Next it
        Else
            GoTo error2
        End If
    Next
    JoinSuiteArray = t3
    Exit Function

error2:
    Err.Raise Number:=1001, _
                    Description:="L'argument n ° " & p + 1 & " n'est pas un array. " & vbCrLf & _
                    "Fonction : JoinSuiteArray. " & vbCrLf & _
                    "Correction : Vérifiez que tous les arguments sont des array à 1 dimension."
    Exit Function
End Function

Sub testjoinSuitearray()
    t = Array(1, 2, 3, 4, 5, 6)
    tx = Array(7, 8, 9, 10)
    Dim tm(1 To 5, 1 To 5)
    tf = JoinSuiteArray(t, tx, tm)
    MsgBox Join(tf, ";")
End Sub

soit je gère les erreurs dans la sub soit je laisse le msgbox avec la description qui m'offre la possibilité d'aller déboguer comme les msgbox d'erreur classique de vba avec le bouton "débogage"