Copier certaines colonnes dans l’ordre choisit par l’utilisateur

Bonjour à tous,

Pour des besoins bien spécifiques, je devais copier certaines colonnes de ma feuille "Parents" vers ma feuille 'Report", souvent, je devais les copier dans un ordre différent que celui de ma feuille "Parents" = (base de données).

J’ai eu la chance de trouver un code qui solutionne ce problème via un formulaire, il fonctionne bien et s’exécute rapidement pour une petite base de données.

Lorsque je lui demande de faire ce même travail pour une base de données importante, le code met un temps certains pour afficher les résultats, d’où ma demande pour l’optimiser afin qu’il puisse s’exécuter assez rapidement.

Je reste à votre disposition pour d’autres informations supplémentaires.

Salutations.

Hello,

Essaie ça

@+

Bonjour BAROUTE78,

Merci pour votre réponse.

J'ai fait mes tests en mettant un timer sur le deux versions, votre proposition et la version postée.

Pas de temps gagné, le deux version ont presque le même temps.

salutations amicales

Bonjour Harzer, BAROUTE78, le forum,

Un essai...à tout hasard..

En neutralisant la progressbar, le temps d'exécution est réduit...mauvais paramétrage ?

Cordialement,

Bonjour xorsankukai,

J’espère que vous allez bien depuis votre dernière proposition.

Merci pour votre retour.

J’ai fait mes tests sur (20000 lignes) avec la version originale comparée à la vôtre, en mettant une timer sur les deux versions, il y’a pas de comparaison à faire, la vôtre a fini après 4 secondes, l’originale : 178 secondes.

J’ai refait par après un test seulement avec la vôtre sur 38000 lignes, malheureusement, j’ai eu une erreur d'exécution 6 dépassement de capacité, pouvez-vous SVP regarder comment peut-on remédier à cela.

Au sujet de la barre de progression, je vous avoue que je ne vois pas l’intérêt, si elle est neutralisée pour un gain temps, cela me convient parfaitement, elle était avec le projet et je l’ai laissé comme tel.

Bien à vous et avec toutes mes salutations.

Bonsoir,

Merci pour le retour,

J’ai refait par après un test seulement avec la vôtre sur 38000 lignes, malheureusement, j’ai eu une erreur d'exécution 6 dépassement de capacité, pouvez-vous SVP regarder comment peut-on remédier à cela.

J'ai déclaré mes variables en Integer(%), donc limitées à 32767=== il faut donc les déclarer en Long(&) : https://www.excel-pratique.com/fr/vba/variables

De même, la méthode transpose est limitée à 65 536 valeurs, me semble-t-il....

Un nouvel essai...

Private Sub CommandButton1_Click()
 Dim tb, ntb(), tablo
 Dim k&, i&, ii%, msg$, j&, x&
 'Dim start As Single
  'start = Timer

 Application.ScreenUpdating = False
 'ProgressDlg.Show 'Progress Bar

  If Me.ListBox2.ListCount = 0 Then
   MsgBox "Aucune colonne à copier ! ", , ""
   Exit Sub
  End If

  With Sheets("Parents")
   tb = .Range("A1").CurrentRegion
    k = 0
     For ii = 0 To Me.ListBox2.ListCount - 1
      For i = 1 To UBound(tb, 2)
       If tb(1, i) Like Me.ListBox2.List(ii) Then
        msg = msg & "," & i
       End If
      Next i
     Next ii
    tablo = Split(Mid$(msg, 2), ",")

      For j = 1 To UBound(tb, 1)
       For x = 0 To UBound(tablo)
        ReDim Preserve ntb(0 To UBound(tb, 1), 0 To UBound(tablo))
        ntb(k, x) = tb(j, Trim(tablo(x)))
      Next x
      k = k + 1
     Next j
  End With

    With Sheets("Report")
     .Cells.Clear
     If k > 0 Then
      .Range("A1").Resize(k, UBound(tablo, 1) + 1) = ntb
      .Range("A1").Resize(1, UBound(tablo) + 1).Interior.Color = RGB(218, 238, 243)
      .Range("A1").Resize(1, UBound(tablo) + 1).Font.Bold = True
      .Columns.AutoFit
     End If
    End With
  CommandButton6.Enabled = True
 Unload Me
 'MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

Cordialement,

bonjour le fil

"De même, la méthode transpose est limitée à 65 536 valeurs, me semble-t-il...."

oui, transpose est limitée à 65.536, malheureusement

Bonjour BsAlv & xorsankukai,

Merci à xorsankukai pour votre retour, pour le lien pour les variables et le 2^e code .

Merci à BsAlv de confimer que méthode transpose est limitée à 65 536 valeurs.

xorsankukai , vu que vous avez changé la nature de la variable, il n’y plus de problème.

Je vous avoue que je ne savais pas que le symbole % représente integer et le symbole & représente long.

Bonne soirée à tous les deux et merci pour le partage.

Cordialement.

Bonjour le fil,

@BsAlv: merci d'avoir confirmé pour application.transpose, j'avais déjà été confronté à ce souci, mais je ne m’en souvenais plus.

@Harzer: ravi que cela fonctionne,

xorsankukai , vu que vous avez changé la nature de la variable, il n’y plus de problème.

J'ai également modifié la construction du tableau ntb pour ne plus avoir à transposer==> j'ai fait le test sur 100 000 lignes, ça passe,

Bonne continuation,

Cordialement,

bonjour le fil,

@xorsankukai,

avec application.index, on sait faire de belles choses . Il faut définir quelles lignes et colonnes que vous voulez copier et coller. Il faut faire attention aux dimensions : aLignes = (1 to x, 1 to 1) et aCol = (1 to y) !!! Pour excel2021 et 365, c'est encore plus facile de créer aLignes avec aLignes = Application.Sequence(x) avec x le nombre de lignes au lieu de cette construction avec s&evaluate (avec x jusqu'à 1.048.000 et un petit peu)

Sub teste()
     Changer_Colonnes ",1,3,5,7,9,11,10,8,6,4,2"     'ceci est un exemple de votre string "msg" dans l'userform
End Sub

Sub Changer_Colonnes(sSequence)
     Dim aA, s, aLignes, aCol

     t = Timer
     ax = Application.Sequence(1000)
     aA = Sheets("parents").Range("A1").CurrentRegion.Value2     'lire le contenu vers une matrice
     If UBound(aA) > 1 And Len(sSequence) > 1 Then     'l'application.index ne fonctionne pas avec <= 1 ligne
          If False Then     'quelle version excel ???
               aLignes = WorksheetFunction.Sequence(UBound(aA))     'seulement pour excel 2021 et 365
          Else
               s = "row(a1:a#)"     'formule pour créeer tous les numéros des lignes à partir de 1 jusqu'à #, donc 1,2,3,4,5,6,...,#
               aLignes = Evaluate(Replace(s, "#", UBound(aA)))     'executer cette formule pour le nombre de lignes de aA, resultat est une matrice
          End If
          aCol = Application.Transpose(Application.Transpose(Split(Mid(sSequence, 2), ",")))     'une matrice avec la séquence des colonnes

          With Sheets("Report").Range("A1").Resize(UBound(aA), UBound(aCol))   'plage pour coller
               .Parent.UsedRange.ClearContents     'RAZ la feuille
               t1 = Timer
               .Value = Application.Index(aA, aLignes, aCol)     'coller dans l'ordre voulu
               .EntireColumn.AutoFit     'adapter le largeur des colonnes
               Application.Goto .Cells(2, 1)
               Application.CutCopyMode = False
          End With
          MsgBox "prêt en " & Format(Timer - t, "0.00\s") & vbLf & vbLf & "RAZ et ... en " & Format(t1 - t, "0.00\s") & vbLf & "coller en " & Format(Timer - t1, "0.00\s"), vbInformation, Mid(sSequence, 2)
     Else
          MsgBox "problème avec nombre de lignes ou colonnes", vbCritical, Mid(sSequence, 2)
     End If
End Sub

Hello BsAlv,

Arghhh ! C'est du high level ! Mais trop compliqué pour ma petite tête, , tu surestimes mes compétences

Je n'ai malheureusement pas pu tester car erreur avec mon excel 2010,

Merci tout de même,

Amitiés,

re,

la macro "Xorsankukai" ne copie que quelque lignes et colonnes et c'est à vous de bien dimensioner les matrices aLignes et aCol (ici le résultat de l'userform). Puis, c'est un simple application.index.

La ligne 1 et la colonne L sont les colonnes et les lignes, pour plus facilement vérifier le résultat dans la feuille "Report"

Je pense avec cet exemple, c'est plus facile à comprendre.

Répéter une colonne plusieurs fois = no problem >>> msg = ",12,1,3,5,7,9,11,10,8,6,4,2,2,2,2,2,2,2,2,2"

Bonjour BsAlv et xorsankukai,

Je suis entièrement d’accords avec xorsankukai pour dire que le code de BsAlv c’est de la haute voltige, c’est trop compliqué pour ma petite tête également.

Le code de BsAlv est du haut niveau.

Merci à tous les deux.

Cordialement.