[Optimisation] code VBA transposition lignes vers colonnes

[Staple1600]

Bonsoir,

Est-ce que vous voyez un moyen d'optimiser le temps de traitement de la macro de transposition?
(ou un autre type de syntaxe)
J'ai ajouté une seconde macro pour créer les conditions de tests
(Le classeur de test doit contenir deux feuilles)

Sub TransposeLIG_COL()
Dim a As Variant, b As Variant
Dim i&, j&, k&
Dim t0 As Double
'Heure départ
t0 = Timer
Application.ScreenUpdating = False
' passage en calcul sur ordre
Application.Calculation = xlCalculationManual
'si error, on saute à FIN: pour remettre le calcul en automatique
On Error GoTo FIN
a = ActiveSheet.Cells(1).CurrentRegion.Value
ReDim b(1 To UBound(a, 1) * (UBound(a, 2) - 2), 1 To 4)
For i = 2 To UBound(a, 1)
  For j = 3 To UBound(a, 2)
    k = k + 1
    b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(1, j): b(k, 4) = a(i, j)
  Next j
Next i
Sheets(2).Cells(1).Resize(UBound(b, 1), UBound(b, 2)).Value = b
FIN:
If Err.Number > 0 Then MsgBox "Erreur n° " & Err.Number & vbLf & Err.Description
Application.Calculation = xlCalculationAutomatic
MsgBox Format(Timer - t0, "0.0 \ sec."), vbInformation, "Temps éxécution macro"
'crédits code: Peter_SSs, ma pomme
End Sub
Sub CreationDonnees()
'macro pour générer des données de test
Application.ScreenUpdating = False
[C1] = 1: [A2:B2] = Array(100002, "DATA2")
[C1:N1].DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
[B2:B30000].DataSeries Rowcol:=xlColumns, Type:=xlAutoFill, Date:=xlDay, Trend:=False
[A2:A30000].DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
[C2:N30000] = "=RANDBETWEEN(1,500)": [C2:N30000] = [C2:N30000].Value
End Sub

PS: la macro de transposition est issue de mes archives (glanée sur le web anglophone)

Sur mon PC de test, le MsgBox affiche entre 9 à 10 secondes
(version Excel pour le test: 2013)
NB: Dans la réalité, le nombre de ligne peut aller jusqu'à plus ou moins 60 000 lignes.

Merci à ceux qui prendront le temps de s’intéresser à la question

 

[laurent950]

Laurent950
J'ai testé ton code (qui est quasi-identique à celui que j'utilise, non ?)
Résultat: 9.5 secondes.

Bonjour Staple1600,
J'ai refais un code qui est en faite identique au votre au final. mais se que j'ai constaté sur mon ordinateur les temps sont.
Pour le transfert des données du tableau a() vers le tableau b() "Soit jusqu’à la transposition final" = 0,1 seconde
Lorsque l'action et faite de copier se tableau vers la feuille excel choisie le temps et de = 1,2 secondes
soit 0,1 seconde de traitement + 1,2 secondes pour coller les données traités vers la feuilles excel
temps global de 1,3 secondes
Je pense qu'il n'y a pas mieux c'est le matériel qui fera la différence.
l'ordi avec le test effectué :
Intel Core i7-8565U (Quad-Core 1.8 GHz / 4.6 GHz Turbo - Cache 8 Mo)
1.8 GHz
16 Go mémoire
je fait pas mieux

Pour le découpage des variables tableaux voir ici : Complet
lien : https://usefulgyaan.wordpress.com/2...cing-an-array-without-loop-application-index/

fichier excel avec toutes les combinaison d’extraction
http://www.excelforum.com/excel-new...rows-and-columns-arguments-as-vba-arrays.html

laurent

 

[Staple1600]

Bonjour à tous

ThomasR (merci pour le code)
Contingence pascale oblige, je ne peux tester aujourd'hui que sur de l'antique
(XP-XL2K3-1Go)
Donc j'ai du adapté le jeu de données en conséquence avec cette macro

Spoiler: Quand on a que 65536 rows ;)

Sub Pour_Test_XLS()
Dim b(1 To 5450, 1 To 12) As String
Dim i&, j&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[C1:N1] = Split("1 2 3 4 5 6 7 8 9 10 11 12")
[A2:A5451].FormulaR1C1 = "=1600+ROW()"
[B2:B5451 ].FormulaR1C1 = "=ADDRESS(ROW(),COLUMN(),4)"
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
For i = 1 To 5450
    For j = 1 To 12
        b(i, j) = Int(1600 * Rnd)
    Next j
Next i
ActiveSheet.Cells(2, 3).Resize(UBound(b, 1), UBound(b, 2)).Value = b
Application.Calculation = xlCalculationAutomatic
End Sub

Evidemment du coup, ca va déjà plus vite
1,6 seconde pour générer le CSV
Je pense pouvoir tester durant le week-end sur Excel 365 et W10 (avec proc Intel)
Mardi, je testerai ton code au boulot (W7Pro+XL2K10+4 ou 8Go)

Laurent950
Pour mon prochain PC, j'éviterai AMD et je pencherai vers Intel)

ma pomme
Je vais adapter ton code pour tester sur un *.xls mais je crois bien qu'Excel 2003 va faire une syncope.
(je te redis ce qu'il en est depuis l'ambulance )

 

[mapomme]

Bonjour @Staple1600 ,

ma pomme
Je vais adapter ton code pour tester sur un *.xls mais je crois bien qu'Excel 2003 va faire une syncope.
(je te redis ce qu'il en est depuis l'ambulance )

Je rappelle que ce code n'était pas écrit pas pour optimiser le tien mais juste pour apprécier "l'étendue des dégâts" quand on passe sur de l'Excel à base de formules. Curieux de découvrir la mesure en XL2003.
Je comprend la méthode CSV, mais ne pas afficher le résultat dans Excel, c'est comme montrer à un homme qui meurt de soif la belle photo d'une bouteille d'eau glacée. Il ne sera toujours pas désaltéré.

 

[ThomasR]

Mdr,
Si tu veux écrire dans excel pour le plaisir tu peux toujours faire un debug.print.

Son besoin est de gêner un csv pas d avoir ses données dans excel.

Pour info le code fonctionnera sous 2003 sans problème comme dit plus haut il est Windows 98 compatible

Cordialement
Thomas

 

[zebanx]

Bonjour à tous (mapomme)

C'est l'une des premières fois que je constate des différences de performance apparaissent avec des multiples significatifs.

Le code est vraiment performant pourtant mais cela fait bien réfléchir :
- marque de processeur
- puissance de la bestiole (fréquence...)
- nombre de coeurs
- mémoire vive

Le mien doit être dans une moyenne basse mais le fil donne envie de poursuivre sur le sujet.
Les écarts de prix ne sont pas non plus à négliger et dépendent des besoins de chacun mais vu la durée de vie des "bécanes", l'amortissement ne parait pas trop significatif pour une utilisation intensive.

Mais en faisant de la simple bureautique, qui est rarement regardé par rapport à d'autres facteurs (vidéos, jeux..), j'avoue que le >9sec vs le <2sec interpelle.

Merci à Staples1600 d'avoir donc lancé ce sujet.

 

[Staple1600]

Re

Une fois, le CSV généré, on l'ouvrir dans Excel et ainsi sa soif étancher

[aparté]
Sinon juste pour faire suite à ce que je n'avais jamais remarqué avant
(et que j'évoque dans le message# 21)

Sub TestSubsidiaire()
Range("A1") = "=N(""STAPLE"")"
Range("A6") = 1600
Range("A15") = "2019"
Range("A1:A15").AutoFill Destination:=Range("A1:A65000"), Type:=xlFillCopy
End Sub

Ensuite quand vous faites un F5->cellules vides, cela mouline aussi chez vous(et ce quelque soit la configuration matérielle) ?
Sur XLS, message d'erreur Selection trop importante
[/aparté]

 

[Hasco]

Bonjour,

Cela mouline un peu (<1.5s) et fonctionne.

Mais votre message d'erreur ne m'étonne pas sur un excel <2007 car rappelez-vous ce que nous étions obligé de faire pour utiliser en vba UNION(rng1,rng2,,,,,,) sur des très nombreuses multi-plage. ça explosait le truc. Je suis sûr que vous vous souvenez de ça

Bonne soirée

 

[mapomme]

Une fois, le CSV généré, on l'ouvrir dans Excel et ainsi sa soif étancher

Et c'est instantané, l'ouverture du fichier CSV ?

nota : soit dit en passant, je connais bien d'autres façons de sa soif étancher bien plus agréables...

 

[Staple1600]

Bonsoir

[mapomme]
Alors là, j'ai mal à mon Excel 2013
Parce que sur un vieux bouzin avec une vieille bouzine d'Excel
(excel 2003)
J'obtiens ce résultat avec ta macro ma pomme: 3,3 secondes
(certes avec moins de lignes au départ XLS oblige)

Sub CreationDonnees()
'macro pour générer des données de test
Application.ScreenUpdating = False
[C1] = 1: [A2:B2] = Array(100002, "DATA2")
[C1:N1].DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
[B2:B5460] = "=""DATA""&ROW()"
[A2:A5460] = "=1600+ROW()+N(""Bravo ma pomme pour cette version formulistique ;-)"")"
[C2:N5460].Formula = "=ADDRESS(ROW(),COLUMN(),4)"
[A2:N5460] = [A2:N5460].Value
End Sub

 

[laurent950]

Bonsoir staple1600, le Forum.
Je sais pas si ont peux gagné en rapidité en exécutant un découpage par bloc.
C'est à dire que la variable tableau b() sera copier par bloc de 5 000 lignes dans la feuilles excel :
le code peux être écrit comme ceux-ci :
exemple ci-dessous.

Sub DecoupageVtab()
' Test de découpage de variable tableau
' https://usefulgyaan.wordpress.com/2...cing-an-array-without-loop-application-index/

    Dim varArray            As Variant
    Dim varTemp             As Variant
    Dim pas                 As Integer: pas = 9
    Dim sh As Worksheet
    Set sh = Worksheets("VdecoupBloc")
    ' Base de donnée récupérer
    varArray = ThisWorkbook.Worksheets("Feuil1").Range("A2:E30")
    ' Découpage en bloc de 10
    For i = 1 To 30 Step 10
        pas = 9 + i
        varTemp = Application.Index(varArray, Evaluate("Row(" & i & ":" & pas & ")"), Application.Transpose(Evaluate("Row(1:" & UBound(varArray, 2) & ")")))
        sh.Cells(sh.Cells(65536, 1).End(xlUp).Row + 1, 1).Resize(UBound(varTemp, 1), UBound(varTemp, 2)).Value = varTemp
    Next i
End Sub

Par contre je n'arrive pas a l'adapter au précédent code ?
Les temps devrait être amélioré je pense !
varTemp = Application.Index(b, Evaluate("Row(" & i & ":" & pas & ")"), Application.Transpose(Evaluate("Row(1:" & UBound(b, 2) & ")")))
Pourtant elle devrait fonctionné puisqu'elle fonctionne bien sur l'exemple ci-dessus !

Sub TransposeLIG_COL_LaurentDecoup()
    Dim sh As Worksheet
    Set sh = Worksheets("Laurent")
    ' http://fordom.free.fr/tuto/OPTIMISATION.htm
    Dim a() As Variant
    Dim b() As Variant
    ' https://forum.excel-pratique.com/viewtopic.php?t=4163
    Dim i As Long
    Dim j As Long
    Dim t0 As Double
    Dim cpt As Long: cpt = 2
'Heure départ
    t0 = Timer
    Application.ScreenUpdating = False
Sheets("Laurent").Columns("a:d").Clear
' passage en calcul sur ordre
    Application.Calculation = xlCalculationManual
'si error, on saute à FIN: pour remettre le calcul en automatique
    On Error GoTo FIN
        a = ActiveSheet.Cells(1).CurrentRegion.Value
            ReDim b(LBound(a, 2) To (UBound(a, 1) * UBound(a, 2) - 2), 1 To 4)
                For j = 2 To UBound(a, 1)
                    For i = 3 To UBound(a, 2)
                        b(cpt, 1) = a(j, 1)
                        b(cpt, 2) = a(j, 2)
                        b(cpt, 3) = a(1, i)
                        b(cpt, 4) = a(j, i)
                        cpt = cpt + 1
                    Next i
                Next j
i = Empty
j = Empty
             
Sheets("Feuil1").Cells(14, 22) = Format(Timer - t0, "0.0 \ sec.")

' Découpage en bloc de 5000
Dim pas                 As Integer: pas = 9
For i = 1 To UBound(b, 1) Step 5000
    pas = 4999 + i
    varTemp = Application.Index(b, Evaluate("Row(" & i & ":" & pas & ")"), Application.Transpose(Evaluate("Row(1:" & UBound(b, 2) & ")")))
    sh.Cells(sh.Cells(65536, 1).End(xlUp).Row + 1, 1).Resize(UBound(varTemp, 1), UBound(varTemp, 2)).Value = varTemp
Next i

Sheets("Feuil1").Cells(15, 22) = Format(Timer - t0, "0.0 \ sec.")
MsgBox Format(Timer - t0, "0.0 \ sec."), vbInformation, "Temps éxécution macro"
Sheets(1).Select

FIN:
    If Err.Number > 0 Then MsgBox "Erreur n° " & Err.Number & vbLf & Err.Description
        'Ré-activations
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
'crédits code: Peter_SSs, ma pomme
End Sub

lien :
http://www.cpearson.com/excel/ArraysAndRanges.aspx

Conclusion :
Données récupéré depuis la feuilles excel est stocké dans un tableau = pas d'incompatibilité de type
- > varArray = Remplis directement depuis la feuille excel = OK
Données remplis directement depuis une variable tableau vers la variable tableau cible = incompatibilité de type
- b() remplis avec a() = incompatibilté de type
la ligne de code qui bloque est :
- Application.Index(varArray, Evaluate("Row(" & i & ":" & pas & ")"), Application.Transpose(Evaluate("Row(1:" & UBound(varArray, 2) & ")")))

 

[Staple1600]

Bonsoir

Laurent950
C'est marrant, G..gl. m'avait amené sur la même syntaxe
Merci pour ce nouveau code que je m'en vais tester illico

 

[Staple1600]

Re

je m'aperçois que j'ai zappé des réponses (c'est normal avec écran si petit)
Donc bonsoir à zebanx, Roblochon.

Plus se déroule le fil, plus je m'inquiété du pourquoi d'un Excel 2013/W10 plus lent que des versions antérieures d'Excel tournant sur des OS anciens.

 

[ThomasR]

Tu as essayé un

Application.EnableEvents = False

au début et vrai à la fin?

 

[Staple1600]

Bonsoir ThormasR

Tu poses la question à qui?
A moi ou Laurent950?

Si c'est à moi puisque Application.Enable n'était pas dans le code initial, logiquement j'aurais avoir des temps proches des votres, non?
(je parle avec le PC avec Excel 2013)

 

[laurent950]

Staple1600
Conclusion :
exemple 1 poste #40
Données récupéré depuis la feuilles excel est stocké dans un tableau = pas d'incompatibilité de type
- > varArray = Remplis directement depuis la feuille excel = OK
varTemp = Application.Index(varArray, Evaluate("Row(" & i & ":" & pas & ")"), Application.Transpose(Evaluate("Row(1:" & UBound(varArray, 2) & ")")))
sh.Cells(sh.Cells(65536, 1).End(xlUp).Row + 1, 1).Resize(UBound(varTemp, 1), UBound(varTemp, 2)).Value = varTemp

exemple 2 poste #40
Données remplis directement depuis une variable tableau vers la variable tableau cible = incompatibilité de type
- b() remplis avec a() = incompatibilté de type
la ligne de code qui bloque est :
varTemp = Application.Index(b, Evaluate("Row(" & i & ":" & pas & ")"), Application.Transpose(Evaluate("Row(1:" & UBound(b, 2) & ")")))
sh.Cells(sh.Cells(65536, 1).End(xlUp).Row + 1, 1).Resize(UBound(varTemp, 1), UBound(varTemp, 2)).Value = varTemp

je comprend pas pourquoi cela fonctionne dans un cas mais pas dans l'autre ?

J'ai laissé le code dans le fichier excel qui fonctionne
dans un cas
mais pas dans l'autre
je comprend pas pourquoi ?