XL 2016 VBA Application.Transpose résultat étrange

Dudu2

XLDnaute Barbatruc
Bonjour,

Un Application.Transpose d'un tableau à 2 dimensions (2ème dimension = 1) rend un tableau à 1 seule dimension. Ok, c'est un spécificité du bidule !
Mais alors pourquoi la dimension du tableau transposé est-elle limité à 34464 éléments ?
Ça ne correspond même pas au nombre Max de colonnes (1 048 576 lignes et 16 384 colonnes).

1609624158666.png
1609624177961.png


Ce truc n'est vraiment pas fiable.
 

Pièces jointes

  • Classeur1.xlsm
    703.3 KB · Affichages: 19
Dernière édition:

eriiic

XLDnaute Barbatruc
Bonjour,

oui, il y a une limite à Transpose(), sans doute qu'ils ont 'oublié' de la faire évoluer depuis 2003 (voire plus) où les processeurs et la mémoire étaient plus limités.
D'autres fonctions matricielles ont cette limitation.
Je pense qu'ils étaient plus ou moins obligés pour avoir une compatibilité descendante.
Il me semblait que c'était 65536 mais visiblement sur ton exemple c'est moitié moins.
Pas d'autre choix que de boucler si tu dépasses.
eric

EDIT : je viens de refaire mes tests :
t = Application.Transpose(Range("A1:A65536"))
donne bien 65536 items
mais dès que tu dépasses :
t = Application.Transpose(Range("A1:A65537")) => 1 !!!
t = Application.Transpose(Range("A1:A70000")) => 4464
ce qui explique ton résultat bizarre à 34464.

La limite est bien 65536 (=2^16)
Au delà il retourne une taille de =MOD(nblignes;65536)
 
Dernière édition:

laurent950

XLDnaute Accro
Bonsoir,
Transpose (Limite a 65536 éléments) ou Redim preserve (Recopie le tableau a chaque tour de boucle) consomme de la mémoire. une alternative
VB:
Sub test()
Application.ScreenUpdating = False
Dim t(), trans() As Variant
'
    t = ActiveSheet.Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Value
'
    MsgBox "Avant Transpose:" & vbCrLf & _
           "t(" & LBound(t, 1) & " to " & UBound(t, 1) & ", " & LBound(t, 2) & " to " & UBound(t, 2) & ")"
'
' manuelle transpose t
ReDim trans(LBound(t) To UBound(t))
    For i = LBound(t) To UBound(t)
           trans(i) = t(i, 1)
    Next i
ReDim t(LBound(trans) To UBound(trans))
t = trans
Erase trans
    MsgBox "Après Transpose:" & vbCrLf & _
           "t(" & LBound(t) & " to " & UBound(t) & ")"
'
Application.ScreenUpdating = True
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Bonjour @eriiiic, laurent950,

Merci pour cette explication de la limite à 65536. C'est clair. Il ne garde que les 16 derniers bits.
Je vais donc éviter cette fonction, pour 2 raisons:
- d'une part à cause de la limite à 65536 même si on a rarement des cas où les feuilles contiennent autant de lignes.
- d'autre part à cause de cette réduction de dimension qu'on doit parfois contrer par un double Transpose pour affecter un Range.
VB:
'--------------------------------------------------------------------
'Fonction de Tranpose selon la logique de WorksheetFunction.Transpose
'sauf que WorksheetFunction.Transpose se limite à 65536 éléments
'alors que cette fonction lève cette limite.
'--------------------------------------------------------------------
Function TransposeExcel(t As Variant) As Variant
    Dim tt() As Variant
    Dim NbDimensions As Integer
    Dim i As Long
    Dim j As Long
    
    If Not IsArray(t) Then
        MsgBox "Function TransposeExcel: error argument is not an array !"
        Exit Function
    End If
    
    '1 ou 2 dimensions pour t ?
    On Error Resume Next
    i = UBound(t, 2)
    If Err.Number Then NbDimensions = 1 Else NbDimensions = 2
    On Error GoTo 0

    '------------------------------------------------------
    'Tableau origine 1 dimension
    '=> Tableau destination 2 dimensions dont la 2ème est 1
    '------------------------------------------------------
    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 i
    End If
    
    '----------------------------
    'Tableau origine 2 dimensions
    '----------------------------
    If NbDimensions = 2 Then
        '-----------------------------------------------
        'Tableau origine 2 dimensions dont la 2ème est 1
        '=> Tableau destination 1 dimension
        '-----------------------------------------------
        If UBound(t, 2) = 1 Then
            ReDim tt(LBound(t, 1) To UBound(t, 1))
            
            For i = LBound(t, 1) To UBound(t, 1)
                tt(i) = t(i, 1)
            Next i
            
        '-------------------------------------------------
        'Tableau origine 2 dimensions dont la 2ème est > 1
        '=> Tableau destination 2 dimensions inversées
        '-------------------------------------------------
        Else
            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
    End If
    
    TransposeExcel = tt
End Function

'------------------------------------------------------------------
'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.
'------------------------------------------------------------------
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
    
    '1 ou 2 dimensions pour t ?
    On Error Resume Next
    i = UBound(t, 2)
    If Err.Number Then NbDimensions = 1 Else NbDimensions = 2
    On Error GoTo 0
    
    't est un tableau à 1 dimension
    If NbDimensions = 1 Then
        TransposeNaturel = t
    
    '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
        
        TransposeNaturel = tt
    End If
End Function
 
Dernière édition:

Statistiques des forums

Discussions
312 305
Messages
2 087 085
Membres
103 461
dernier inscrit
dams94