Limitation Application.Transpose

Bonjour à tous,

Etant un peu bloqué sur un code et un dépassement de capacité, je viens vers vous pour essayer de trouver une solution.

Pour faire simple, j'utilise la fonction application.transpose Hors dans la table que je crée, je dépasse les 65000 lignes (en fait j'en suis à 120000 lignes). Je me retrouve avec une incompatibilité de type.

Quelqu'un aurait il une solution pour contourner le problème ?

Voici mon code :

Option Explicit
Option Private Module

Public Sub Create_Table()
Dim wb As Workbook
Dim wsData As Worksheet, wsTable As Worksheet
Dim lo As ListObject
Dim Cell As Range
Dim tbl, Arr()
Dim I As Long, J As Long, k As Long

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("Compil")
    Set wsTable = wb.Worksheets("Table")
    Set lo = wsTable.ListObjects(1)

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set Cell = .InsertRowRange.Cells(1)
    End With

    tbl = wsData.Cells(1).CurrentRegion.Value
    For I = 2 To UBound(tbl)
        For J = 13 To UBound(tbl, 2)
            If tbl(I, J) <> "" Then
                ReDim Preserve Arr(12, k + 1)
                Arr(0, k) = tbl(I, 1)
                Arr(1, k) = tbl(I, 2)
                Arr(2, k) = tbl(I, 3)
                Arr(3, k) = tbl(I, 4)
                Arr(4, k) = tbl(I, 5)
                Arr(5, k) = tbl(I, 6)
                Arr(6, k) = tbl(I, 7)
                Arr(7, k) = tbl(I, 8) & ", " & tbl(I, 9)
                Arr(8, k) = tbl(I, 10)
                Arr(9, k) = tbl(I, 11)
                Arr(10, k) = tbl(I, 12)
                Arr(11, k) = CLng(tbl(1, J))
                Arr(12, k) = tbl(I, J)
                k = k + 1
            End If
        Next J
    Next I

    If k > 0 Then Cell.Resize(k, 13).Value = Application.Transpose(Arr)
    lo.HeaderRowRange.EntireColumn.AutoFit

End Sub

Bonjour,

arrange-toi pour ne pas devoir faire de .transpose (inverse tes indices dans ton tableau Arr()), cela voudra dire que tu devras estimer la taille maximum que pourra prendre ce tableau et l'indiquer dans une instruction dim, par exemple dim Arr(200000,12) (le redim preserve ne fonctionne pas que si il y a redimensionnement du dernier indice).

une autre manière de faire est de copier ton tableau vers la feuille et de le réinitialiser chaque fois que tu arrives à 65000.

Bonjour,

a priori le tableau Arr ne contiendra pas plus de lignes que le tableau tbl,

on peut donc déclarer directement :

Dim Arr(1 to Ubound( tbl,1), 1 to 12)

et donc plus besoin de Application.Transpose

A+

EDIT: Bonjour h2so4

Bonjour à vous deux,

Déjà bien le merci pour vos réponses.

@AlgoPlus je suis partisan de ton retour, je suis entrain de revoir mon code en fonction de ton aide, mais je bloque encore un peu, surtout qu'en déclarant comme cela, j'ai des constantes requises...

Je vais essayer de me triturer les méninges avec ce que tu m'as donné.

bonjour,

essaie ceci

dim Arr()
ReDim Arr(0 to Ubound( tbl,1), 1 to 12)

Ah bah ! oui !

Boulette !!!

Merci pour ta précision @h2so4

Néanmoins, 2 précisions :

• La première, pour revenir au premier post de AlgoPlus, le nombre de lignes va être différent. En effet, je suis sur un tableau de départ qui comporte 336 lignes et 382 colonnes. Je cherche donc à transformer ces informations en les mettant sous forme d'un autre tableau (pour générer un TCD) ensuite. Quand je par d'un tableau de 70 lignes, mon code fonctionne correctement. Mais là effectivement je me retrouve limité par le transpose.
• La deuxième, j'ai testé différemment les bouts de code fournis. Soit je m'y prends mal, soit j'ai pas pigé une chose, mais je suis bloqué le code me revient en incompatibilité de type.

Pour être plus clair, enfin j'espère, je mets un fichier exemple en pièce jointe (fichier ne comportant pas toutes les lignes de départ sous "compil")

Bonjour à tous,

Ca bien longtemps que je n'utilise plus Application.Transpose, depuis que je me la suis ré-écrite avec des entiers-longs pour manipuler les "gros" tableaux.

Tiens, c'est cado :

' *****  CODE PierreP56 : http://tatiak.canalblog.com/  *****
Function Transpose(Ttk As Variant) As Variant
Dim T As Variant, lg As Long, cl As Long, i As Long, j As Long

    lg = UBound(Ttk, 1)
    cl = UBound(Ttk, 2)
    ReDim T(LBound(Ttk, 2) To cl, LBound(Ttk, 1) To lg)
    For i = LBound(Ttk, 2) To cl
        For j = LBound(Ttk, 1) To lg
            T(i, j) = Ttk(j, i)
        Next j
    Next i
    Transpose = T
End Function

Elle est déjà présente dans nombreux de mes fichiers proposés sur ce forum.

Pierre

bonjour,

proposition de correction de ton code

Public Sub Create_Table()
    Dim wb As Workbook
    Dim wsData As Worksheet, wsTable As Worksheet
    Dim lo As ListObject
    Dim Cell As Range
    Dim tbl, Arr()
    Dim I As Long, J As Long, k As Long

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("COMPIL")
    Set wsTable = wb.Worksheets("TABLE")
    Set lo = wsTable.ListObjects(1)

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set Cell = .InsertRowRange.Cells(1)
    End With
    tbl = wsData.Cells(1).CurrentRegion.Value
    ReDim Arr(UBound(tbl, 1) * UBound(tbl, 2), 12)

    For I = 2 To UBound(tbl)
        For J = 13 To UBound(tbl, 2)
            If tbl(I, J) <> "" Then
                Arr(k, 0) = tbl(I, 1)
                Arr(k, 1) = tbl(I, 2)
                Arr(k, 2) = tbl(I, 3)
                Arr(k, 3) = tbl(I, 4)
                Arr(k, 4) = tbl(I, 5)
                Arr(k, 5) = tbl(I, 6)
                Arr(k, 6) = tbl(I, 7)
                Arr(k, 7) = tbl(I, 8) & ", " & tbl(I, 9)
                Arr(k, 8) = tbl(I, 10)
                Arr(k, 9) = tbl(I, 11)
                Arr(k, 10) = tbl(I, 12)
                Arr(k, 11) = tbl(1, J)
                Arr(k, 12) = tbl(I, J)
                k = k + 1
            End If
        Next J
    Next I

    If k > 0 Then Cell.Resize(k, 13).Value = (Arr)
    lo.HeaderRowRange.EntireColumn.AutoFit

End Sub

Bonjour pierrep56,

Bien sympa ta fonction, chose à laquelle je n'avais jamais pensé sous vba, faire des fonctions personnalisées.

En tout cas, en effet, cela fonctionne parfaitement.

Tout comme pour @h2so4. A vrai dire, c'est moi qui ai pas été très bon sur ce coup, j'ai mal positionné la ligne dans le code, je comprends mieux mon erreur.

En tout cas merci beaucoup à tous les 3, j'ai appris quelque chose de nouveau aujourd'hui sur excel et le vba !