Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Transférer un tableau plus rapidement

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion MJ13
  • Date de début Date de début

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

MJ13

XLDnaute Barbatruc
Bonjour à tous

J'ai un fichier avec des noms de dossiers et de fichiers.

je voudrais les mettre en tableau de 8 colonnes pour faire des planches contact.

J'ai fait une macro pour les dispatcher. Mais si j'ai 65 000 lignes, cela va prendre environ 6 minutes sur mon PC.

Pourrait-on aller plus vite en VBA avec la notion de tableaux que je ne maîtrise pas?

Voir pièce jointe.

Merci d'avance 😉.
 

Pièces jointes

Trier par date Trier par votes
Re : Transférer un tableau plus rapidement

Bonjour MJ13,

Un essai par tableau dynamique.

Cela semble fonctionner sur les 1000 lignes, à voir sur les 65000.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Transférer un tableau plus rapidement

Bonjour Bernard

Déjà, félicitation pour ton passage au rang de de Barbatruc. J'éspère que d'autres vont le signaler sinon...

Merci beaucoup pour ta macro qui à l'air ultra rapide (1 seconde, on dirait Bip Bip 🙂), mais sur un fichier d'un peu plus de 63000 lignes, il ne m'en trouve que environ 37000.

Comme cela me dépasse un peu tous ces codes de tableaux 😕.

Vois-tu d'où cela peut-il provenir?
 
Vote positif 0 Vote négatif
Re : Transférer un tableau plus rapidement

Bonjour à tous

Mon essai :

VB: 
Sub transfert_tableau()
nb_colonne_max = 8
Dim mon_nouveau_tableau As Variant

'définir le tableau source :
mon_tableau = Sheets(1).Range("A2:B" & Sheets(1).Range("B65536").End(xlUp).Row).Value

'définir le tableau cible (10000 car on ne connait pas le nombre de ligne max)
ReDim mon_nouveau_tableau(1 To 10000, 0 To nb_colonne_max) '( 0 = colonne titre)

ligne = 1
col = 1
dossier_actu = mon_tableau(1, 1)
mon_nouveau_tableau(1, 0) = dossier_actu

For i = LBound(mon_tableau) To UBound(mon_tableau) 'pour toutes les valeurs du tableau source
    If mon_tableau(i, 1) = dossier_actu Then 'si le dossier de la ligne reste le meme...
        
        If col = nb_colonne_max + 1 Then 'colonne max atteinte
            col = 1
            ligne = ligne + 1
            mon_nouveau_tableau(ligne, 0) = dossier_actu
        End If
        
        mon_nouveau_tableau(ligne, col) = mon_tableau(i, 2)
        col = col + 1
    Else '...sinon changement de ligne
        ligne = ligne + 1
        col = 1
        dossier_actu = mon_tableau(i, 1)
        mon_nouveau_tableau(ligne, 0) = dossier_actu
        mon_nouveau_tableau(ligne, col) = mon_tableau(i, 2)
        
        col = col + 1
    End If
Next


'restitution du tableau
Sheets(2).Range("A1:I10000") = mon_nouveau_tableau
Cdt
Olivier
 
Vote positif 0 Vote négatif
Re : Transférer un tableau plus rapidement

J'avoue avoir quand même mis plus de temps à faire mon programme qui est sensiblement le même, (sauf la fin de celui de Bernard qui est bien plus jolie : .Range("A1").Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes)
bravo !

EDIT :
MJ13 à dit:
...mais sur un fichier d'un peu plus de 63000 lignes, il ne m'en trouve que environ 37000...
Cliquez pour agrandir...

Chez moi (Excel 2003) le code de Bernard fonctionne bien sur 65000 lignes
mais j'ai testé avec des noms de dossier indentique : y en a t-il beaucoup de différents ?

EDIT 2 : j'en dis pas mal des conneries quand même....

++
Olivier
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Transférer un tableau plus rapidement

Re, Bonjour Odesta.

Merci beaucoup pour ta macro qui après une petite adaptation (en effet je peux avoir plus de 10000 dossiers différents).

Je passe d'environ 6 minutes à 3,7 secondes (soit 100 fois plus rapide, c'est cool 🙂).

"Je les aurais un jour les tableaux, je les aurais" 😛

Code: 
Sub transfert_tableau()
'Odesta
t1 = Timer
nb_colonne_max = 8
Dim mon_nouveau_tableau As Variant
'définir le tableau source :
mon_tableau = Sheets(1).Range("A2:B" & Sheets(1).Range("B65536").End(xlUp).Row).Value
'définir le tableau cible (10000 car on ne connait pas le nombre de ligne max)
ReDim mon_nouveau_tableau(1 To 60000, 0 To nb_colonne_max) '( 0 = colonne titre)
ligne = 1
col = 1
dossier_actu = mon_tableau(1, 1)
mon_nouveau_tableau(1, 0) = dossier_actu
For i = LBound(mon_tableau) To UBound(mon_tableau) 'pour toutes les valeurs du tableau source
    If mon_tableau(i, 1) = dossier_actu Then 'si le dossier de la ligne reste le meme...
 
        If col = nb_colonne_max + 1 Then 'colonne max atteinte
            col = 1
            ligne = ligne + 1
            mon_nouveau_tableau(ligne, 0) = dossier_actu
        End If
 
        mon_nouveau_tableau(ligne, col) = mon_tableau(i, 2)
        col = col + 1
    Else '...sinon changement de ligne
        ligne = ligne + 1
        col = 1
        dossier_actu = mon_tableau(i, 1)
        mon_nouveau_tableau(ligne, 0) = dossier_actu
        mon_nouveau_tableau(ligne, col) = mon_tableau(i, 2)
 
        col = col + 1
    End If
 
Next
 
'restitution du tableau
Sheets(2).Range("A1:I60000") = mon_nouveau_tableau
t2 = Timer: MsgBox (t2 - t1)
End Sub

EDIT 2 : j'en dis pas mal des conneries quand même....
Cliquez pour agrandir...

Moi, cela me plairaît de dire des c......es comme ça 😉.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Transférer un tableau plus rapidement

Re,

Bonjour à tous

essaie avec ce code :

Sub Img_Planche_Contact()
Dim i As Long, j As Byte, n As Long, Z As Long, Tablo, TabRes, T1, T2
T1 = Timer
With Sheets("Feuil1")
Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row)
Z = UBound(Tablo, 1)
End With
ReDim TabRes(1 To Z, 1 To 9)
n = 1
For i = 1 To Z
TabRes(i, 1) = Tablo(n, 1)
For j = 2 To 9
If Tablo(n, 1) <> TabRes(i, 1) Then Exit For
TabRes(i, j) = Tablo(n, 2) ' Fin de la ligne avant 9
n = n + 1
If n > Z Then Exit For ' fin du tableau
Next j
If n > Z Then Exit For ' fin du tableau
Next i
Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet
.Range("A1").Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
End With
T2 = Timer: MsgBox (T2 - T1)
End Sub

Le tableau TabRes est agrandi en nombre de lignes.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
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

O
  • Question Question
XL 2016 transférer les données d'un tableau brut, dans un autre format pour analyse.
Réponses
12
Affichages
456
ORL
O
  • Question Question
XL 2021 Mise à jour d'un tableau depuis une feuille Excel
Réponses
5
Affichages
214
thunder23
D
  • Question Question
Microsoft 365 faire un tableau de suivi d'activité sur la base d'un TCD avec filtre
Réponses
0
Affichages
121
Daniel200666
D
M
  • Question Question
XL 2021 Fichier de suivi avec liens et formules
Réponses
4
Affichages
254
Mily74
M
J
  • Résolu(e)
Autres Créer des liens hypertexte automatiques et dans plusieurs colonnes dans un tableau excel
Réponses
8
Affichages
383
JMC
J
P
  • Résolu(e)
Microsoft 365 Mise en surbrillance de prix min et max (mise en forme conditionnelle)
Réponses
6
Affichages
184
Pepepichnette69
P
J
  • Question Question
Microsoft 365 Naviguer dans un tableau pour copier des données dans un modèle et copier l'un derrière l'autre
Réponses
11
Affichages
286
AtTheOne
F
  • Question Question
XL 2021 Power Query : extraire tableaux et données de PDF
Réponses
0
Affichages
301
Florent74
F
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
544
jeff1494
  • Résolu(e)
XL 2010 tableau de comptage sans doublon
2 3
Réponses
44
Affichages
2 K
cathodique
  • Question Question
Microsoft 365 Modifier l'ordre de présentation des données dans un graphique Secteur
Réponses
6
Affichages
405
crocrocro
C
R
  • Question Question
Microsoft 365 Colorier ligne si
Réponses
3
Affichages
339
sylvanu
D
  • Résolu(e)
Microsoft 365 Problème interférences entre macros
Réponses
14
Affichages
258
Phil69970
  • Question Question
XL pour MAC Création tableau Olympiades
Réponses
3
Affichages
927
estebat
A
  • Résolu(e)
Microsoft 365 Alimenter automatiquement un tableau à partir des données d'un autre tableau en fonction d'un critère
Réponses
9
Affichages
1 K
Alexandrax971
A
D
  • Résolu(e)
Microsoft 365 Macro pour rafraîchir les liaisons
Réponses
11
Affichages
413
AtTheOne
M
  • Question Question
Power Query Convertir un fichier Contacts Gmail et fichier Excel
Réponses
13
Affichages
1 K
nat54
C
  • Question Question
XL 2019 Récupérer titre de ligne et colonne quand une cellule est rempli dans un tableau
Réponses
3
Affichages
444
Clemee61
C
C
  • Question Question
XL 2016 Faire un tableau de nombres uniques puis associer des images aux cellules
Réponses
4
Affichages
523
DJunqueira
D
N
  • Résolu(e)
XL 2021 Jointure Excel multicritères
Réponses
3
Affichages
423
Nasseuz
N
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…