Limite dans Excel ?

Bonjour,

On m'a aidé ici pour une macro excel, merci encore, mais apparemment je suis limité dans le traitement désiré.

Je n'ai pas précisément mesuré mais à 50.000 lignes cela passe et à 98.000 lignes cela ne passe pas ..

le débogueur s'arrête sur la ligne en gras souligné.

Merci si vous pouvez me dépanner.

Sub Inserer()

Set fa = ActiveSheet

Set fr = Sheets("Résultat")

tablo = fa.Range("A1:H" & fa.Range("A" & Rows.Count).End(xlUp).Row)

id = tablo(2, 5)

ReDim Preserve tabloR(1 To 10, 1 To 4)

tabloR(10, 1) = "<name>" & tablo(2, 2) & "</name>"

tabloR(10, 2) = "<description>" & tablo(2, 2) & "</description>"

tabloR(10, 3) = "<styleUrl>#multiTrack</styleUrl>"

tabloR(10, 4) = "<gx:Track>"

k = 4: n = 1

For i = 2 To UBound(tablo, 1)

If tablo(i, 5) = id Then

ReDim Preserve tabloR(1 To 10, 1 To k + 1)

For j = 1 To UBound(tablo, 2)

tabloR(j, k + 1) = tablo(i, j)

Next j

tabloR(j + 1, k + 1) = tablo(i, 8)

k = k + 1

Else

ReDim Preserve tabloR(1 To 10, 1 To k + 7)

tabloR(10, k + 1) = "</gx:Track>"

tabloR(10, k + 2) = "</Placemark>"

tabloR(10, k + 3) = "<Placemark>"

tabloR(10, k + 4) = "<name>" & tablo(i, 2) & "</name>"

tabloR(10, k + 5) = "<description>" & tablo(i, 2) & "</description>"

tabloR(10, k + 6) = "<styleUrl>#multiTrack</styleUrl>"

tabloR(10, k + 7) = "<gx:Track>"

id = tablo(i, 5)

n = n + 1

k = k + 7

End If

Next i

fr.Range("A1").CurrentRegion.ClearContents

fr.Range("A1").Resize(UBound(tabloR, 2), 10) = Application.Transpose(tabloR)

fr.Activate

End Sub

Bonjour,

En effet, la fonction Transpose de Excel est limitée car elle a été écrite dans une de ses toutes premières versions (qui contenait moins de lignes que maintenant)

Pour contourner ce pb, c'est simple il suffit de se réécrire cette fonction.

Voici ma version perso :

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

Ce qui permet d'écrire tout simplement :

fr.Range("A1").Resize(UBound(tabloR, 2), 10) = Transpose(tabloR)

Pierre

Ben MERCI Pierre, tu m'évites bien des manipulations diverses et avariées

Encore merci aux gens qui se dévouent pour les autres sur ce site.