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

Sub test()
    Dim LB1&, LB2&, DiM1&, DiM2&
    DiM1 = 0
    DiM2 = 1
    basedemandée = 1
    LB1 = Sgn(basedemandée - DiM1)
    LB2 = (basedemandée - DiM2)

    MsgBox "la nouvelle base du tableau sera" & vbCrLf & _
            "dim1 : " & DiM1 + LB1 & vbCrLf & _
            "dim2 : " & DiM2 + LB2


End Sub

Sub test2()
    Dim T2, T3, T4, T5
    Dim tx
    Set bench2 = New cBenchmark
    bench2.Message = True
    tx = InitTable1
    bench2.SubName = "Test des fonction de transposition Patricktoulon / @mapomme / dudu2"
    bench2.Start
    ''texte = "Avant" & vbCrLf & "base dim 1 : " & LBound(tx) & vbCrLf & "base dim 2 : " & LBound(tx, 2) & vbCrLf
    ' MsgBox texte & "Après" & vbCrLf & "base dim 1 : " & LBound(T2) & vbCrLf & "base dim 2 : " & LBound(T2, 2)
    bench2.TrackByName "------ ma pomme ------"
    T2 = TransposeBaseUn(tx) '
    bench2.TrackByName "vba transpose version @mapomme"
    bench2.TrackByName "------ dudu2 -------"
    T3 = TransposeNaturel(tx) '
    bench2.TrackByName "vba transpose version @dudu2"
    bench2.TrackByName "------ job75 -------"
    T4 = TransposeX(tx) '
    bench2.TrackByName "vba transpose version @job75"
    bench2.TrackByName "------ patricktoulon ------"
    T5 = TransposeXV1(tx) 'possibilite de choisir la base en 2d argument
    bench2.TrackByName "vba transpose version patricktoulon"
End Sub

Dim bench As cBenchmark

Sub test2()
    Dim tx(1 To 50000, 1 To 100)
    Set bench2 = New cBenchmark
    bench2.Message = True


    bench2.SubName = "Test des fonction de transposition Patrictoulon / @mapomme / dudu2"
    bench2.TrackByName "debut de transposition avec vba transpose version patricktoulon"
    T2 = TransposeXV1(tx) 'possibilite de choisir la base en 2d argument
    bench2.TrackByName "fin de transposition avec vba transpose version patricktoulon"
    ''texte = "Avant" & vbCrLf & "base dim 1 : " & LBound(tx) & vbCrLf & "base dim 2 : " & LBound(tx, 2) & vbCrLf
    ' MsgBox texte & "Après" & vbCrLf & "base dim 1 : " & LBound(T2) & vbCrLf & "base dim 2 : " & LBound(T2, 2)

    Erase T2
    bench2.TrackByName "------------"
    bench2.TrackByName "------------"

    bench2.TrackByName "debut de transposition avec vba transpose version @dudu2"
    T2 = TransposeNaturel(tx) '
    bench2.TrackByName "fin de transposition avec vba transpose version @dudu2"

    bench2.TrackByName "-------------"
    bench2.TrackByName "-------------"
    Erase T2

    bench2.TrackByName "debut de transposition avec vba transpose version @mapomme"
    T2 = TransposeBaseUn(tx) '
    bench2.TrackByName "fin de transposition avec vba transpose version @mapomme"



End Sub

Sub Test()
    Dim Tbl1 As ListObject
    Dim Tbl2 As ListObject
    Dim UBound1 As Long
    Dim UBound2 As Long
    '
    Dim t() As Variant
    Dim tt() As Variant
    Dim iSelectedNames As Integer
    Dim i As Long
    Dim j As Long
    Dim bm As New cBenchmark
   
    'Initializations
    Erase TabSelectedNames
   
    Set Tbl1 = ActiveSheet.ListObjects("Tableau1")
    UBound1 = Tbl1.ListColumns("Valeur").DataBodyRange(1)
    UBound2 = Tbl1.ListColumns("Valeur").DataBodyRange(2)
    '
    Set Tbl2 = ActiveSheet.ListObjects("Tableau2")
   
    GoSub InitTable
   
    GoSub DébutTrackByName
    tt = Application.Transpose(t)
    GoSub FinTrackByName
   
    GoSub InitTable
   
    GoSub DébutTrackByName
    tt = TransposeNaturel(t)
    GoSub FinTrackByName
   
    GoSub InitTable
   
    GoSub DébutTrackByName
    tt = TransposeNaturel(t)
    GoSub FinTrackByName
   
    GoSub InitTable
   
    GoSub DébutTrackByName
    tt = TransposeBaseUn(t)
    GoSub FinTrackByName
 
    Exit Sub
   
InitTable:
    Erase t
    Erase tt
   
    ReDim t(1 To UBound1, 1 To UBound2)
   
    For i = 1 To UBound1
        For j = 1 To UBound2
            t(i, j) = Chr(64 + j) & CStr(i)
        Next j
    Next i
    Return
   
DébutTrackByName:
    iSelectedNames = iSelectedNames + 1
    bm.TrackByName "Début " & Tbl2.ListColumns(1).DataBodyRange(iSelectedNames).Value
    Return
   
FinTrackByName:
    bm.TrackByName "Fin " & Tbl2.ListColumns(1).DataBodyRange(iSelectedNames)
    Call AddToSelectedNames("Fin " & Tbl2.ListColumns(1).DataBodyRange(iSelectedNames).Value)
    Return
End Sub