XL 2016 Déplacer données

loulourav · 2 Juin 2020

Bonjour à tous,

J'ai un fichier qui s'alimente chaque jour de nouvelles données, chaque jour est ajouté 3 nouvelles colonnes (date/dispo/taux) au fichier qui contient 16 lignes de valeurs (fixe).
Je voudrais que ces bloc de 3 colonnes soient tous regroupés sous 3 colonnes fixes (date/dispo/taux) en répétant les données de ma zone fixe (16 lignes et 9 colonnes)
je joins un fichier exemple avec le résultat escompté en 2ème onglet.
Je ne sais pas si c'est le VBA le plus adapté ??
Dans l'attente de vous lire !

cordialement

mapomme · 2 Juin 2020

Bonjour @loulourav,

Une piste avec du VBA dans le fichier joint. Cliquez sur le bouton Hop!
Le code est dans module1 :

VB:

Sub Deplacer()
Dim t, max&, n&, i&, j&, k&

   With Sheets("Feuil1")
      t = Intersect(.Range("A1").CurrentRegion, .Rows("2:17"))
   End With

   If UBound(t, 2) > 9 Then
      max = 16 * (1 + Int((UBound(t, 2) - 9) / 3))
      ReDim v(1 To max, 1 To 12)
      For j = 10 To UBound(t, 2) Step 3
         For i = 1 To 16
            n = n + 1
            For k = 1 To 9: v(n, k) = t(i, k): Next
            For k = 1 To 3: v(n, k + 9) = t(i, j + k - 1): Next
         Next i
      Next j
   End If

   With Sheets("Feuil2")
      .Range("A1").CurrentRegion.Clear
      Sheets("Feuil1").Range("a1:L1").Copy .Range("a1:L1")
      If UBound(t, 2) > 9 Then .Range("a2").Resize(n, UBound(v, 2)) = v
      .Columns("L:L").NumberFormat = "# ##0.000"
      .Activate
   End With
End Sub

edit : Bonsoir @pierrejean

pierrejean · 2 Juin 2020

Bonjour loulourav

Un essai
Edit : Salut tapomme

sylvanu · 2 Juin 2020

Bonjour Loulourav,
Un essai en PJ.
Comme non précisé, je copie aussi les formats jaune vert.

bonjour Mapomme, Petitpierre,
il semblerait que je soit à labour.

loulourav · 2 Juin 2020

bonjour @mapomme !
Merci ca fonctionne nickel ! j'ai testé sur mon extraction complète et tout se passe bien !
bon j'ai essayé de lire le code mais je ne connais pas Ubound ni Int()
bref si tu as un peu de temps à me consacrer pour détailler un peu la procédure je t'en serais très reconnaissant !
merci beaucoup tout cas !

Edit :
bonjour pierrejean, sylvanu ! je regarde vos propositions ! ne soyez pas jaloux tout de suite !!! lol merci +++

sylvanu · 2 Juin 2020

Re le fil,
Pour infos et pour le fun, temps d’exécution du transfert sur mon PC :
- MaPomme : 0.101 s
- PetitPierre : 0.085 s
- Sylvanu : 0.183 s

mapomme · 2 Juin 2020

Bonsoir @sylvanu

Tes résultats de durée me surprennent.

Voir le fichier joint qui compare les trois méthodes avec ou sans beaucoup de colonnes sources.
Je n'ai pas les mêmes résultats

sylvanu · 3 Juin 2020

Bien le bonjour tout le monde.
J'avais juste mis T0=timer après sub et Timer-T0 avant end sub sur nos trois fichiers respectifs.
Votre exemple ne change pas grand chose, je suis bon dernier.
Ma double boucle, stupide, n'arrange pas les choses. Je voulais juste comprendre pourquoi, et m'améliorer un peu.

mapomme · 3 Juin 2020

sylvanu à dit:
Votre exemple ne change pas grand chose, je suis bon dernier.

Allons, allons, vous êtes sur le podium, vous êtes troisième.

loulourav · 3 Juin 2020

Bonjour à tous !

alors les 3 solutions fonctionnent parfaitement, les solutions de mapomme et pierrejean sont un peu plus compliquée à comprendre pour moi (sans explication) que celle de sylvanu que j'arrive à décoder
bref merci à tous les 3 !

XL 2016 Déplacer données

loulourav

XLDnaute Occasionnel

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

loulourav

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

loulourav

XLDnaute Occasionnel

Discussions similaires