[Optimisation] code VBA transposition lignes vers colonnes

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Staple1600

Staple1600

XLDnaute Barbatruc
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)
VB: 
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 😉
 
Trier par date Trier par votes
Staple1600 à dit:
Laurent950
J'ai testé ton code (qui est quasi-identique à celui que j'utilise, non ?)
Résultat: 9.5 secondes.
Cliquez pour agrandir...
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
 
Dernière édition:
Vote positif 0 Vote négatif
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
VB: 
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 😉)
 
Vote positif 0 Vote négatif
Bonjour @Staple1600 😉,
Staple1600 à dit:
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 😉)
Cliquez pour agrandir...

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é.
 
Dernière édition:
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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. 😎
 
Vote positif 0 Vote négatif
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)
VB: 
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é]
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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)
VB: 
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
 
Dernière édition:
Vote positif 0 Vote négatif
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/
VB: 
    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 !

VB: 
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) & ")")))
 
Dernière édition:
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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)
 
Vote positif 0 Vote négatif
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 ?
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

cathodique
  • Résolu(e)
XL 2010 Erreur de compilation - Incompatibilité de type: tableau ou type défini par l'utilisateur
Réponses
3
Affichages
256
cathodique
cathodique
R1-
  • Résolu(e)
Microsoft 365 Problème de formatage de dates au format EUR
Réponses
2
Affichages
68
R1-
R1-
klin89
  • Question Question
Microsoft 365 Méthode Evaluate pour se dispenser d'une boucle imbriquée
Réponses
14
Affichages
396
patricktoulon
patricktoulon
patricktoulon
  • Question Question
Autres la fonction similaire
Réponses
11
Affichages
485
patricktoulon
patricktoulon
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
5
Affichages
117
chris
chris
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
599
AtTheOne
AtTheOne
cathodique
  • Question Question
XL 2010 Code de l'IA à corriger
2 3
Réponses
33
Affichages
2 K
cathodique
cathodique
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
334
Gestionnaire_rh
G
BenHarber
  • Question Question
Microsoft 365 Commande VBA pour supprimer plusieurs lignes d'un tableau structuré
Réponses
7
Affichages
131
mapomme
mapomme
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
171
telemarrk
T
M
  • Question Question
XL 2019 Optimisation de code VBA
2 3
Réponses
33
Affichages
3 K
mmaiga
M
C
  • Question Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
432
CathyLD
C
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
503
GClaire
G
Sergent_Lipton
  • Résolu(e)
Microsoft 365 [VBA] Barre de recherche dynamique - objectif : cacher les lignes hors résultat
Réponses
3
Affichages
454
Sergent_Lipton
Sergent_Lipton
Regueiro
  • Question Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
754
sylvanu
sylvanu
E
  • Question Question
Microsoft 365 Listbox avec plus de 10 colonnes
Réponses
6
Affichages
549
Excellearning
E
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
2 K
job75
job75
C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
584
Claudinedu13
C
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
405
Gégé-45550
Gégé-45550
G
  • Question Question
XL 2021 Macro pour changer les titres de fichier d'archive
Réponses
3
Affichages
98
fanch55
fanch55
Retour