Macro: deplacer tableau excel

[pael]

Bonjour,

J'ai des centaines de tableaux de largeur fixe 4 colonnes mais de longeur variable jusaqu'a 10 lignes.
Ces tableaux sont affichés l'un après l'autre dans le sens horizontal.
je voudrais essayer de faire une macro qui puisse les afficher l'un en dessous de l'autre (sens verticale).

Quelqu'un a t-il une piste?

Merci d'avance !!!

 

[job75]

Re : Macro: deplacer tableau excel

Bonjour pael, bienvenue sur XLD,

A priori en VBA ce n'est pas très compliqué, il faut faire une boucle pour passer en revue tous les tableaux, les copier et les coller au bon endroit.

Merci de joindre un fichier simplifié (au format 2003 .xls de préférence, <48 Ko et/ou zippé), avec seulement quelques tableaux, et une feuille montrant bien le résultat à obtenir.

A+

 

[pael]

Re : Macro: deplacer tableau excel

Voilà le fichier joint:
Sur la 1er feuille les tableaux de données brute,
sur la 2eme : le résultat souhaité.

merci

 

[job75]

Re : Macro: deplacer tableau excel

Re,

La macro dans un Module (Alt+F11) :

Sub Résultat()
Dim col As Integer, lig As Long, h As Byte
Application.ScreenUpdating = False
With Sheets("Résultat")
  .Range("A:D").Clear
  lig = 2
  For col = 1 To 5 * Application.CountA(Range("2:2")) / 3 - 4 Step 5
    h = Cells(20, col + 1).End(xlUp).Row - 1
    Cells(2, col).Resize(h, 4).Copy .Cells(lig, 1)
    lig = lig + h + 1
  Next
  .Activate
End With
End Sub

Je restitue dans la feuille "Résultat" mais on peut tout aussi bien restituer dans la feuille d'origine, Edit : à condition de remplacer :

.Range("A:D").Clear

par :

.Range("A9:D65536").Clear

A+

 

[pael]

question supplémentaire

Merci ca fonctionne parfaitement,

Mais j'ai une ème question pour améliorer la macro :

En fait dans ma liste de tableau j'ai en fait une serie de 4 tableaux :
Q1: Arles/huveaune/tarascon/vieux port Q2 :Arles/huveaune/tarascon/vieux port

Ma question:
est-il possible lorsque je fais ce déplacement d'horizontal à la verticale d'inverser l'ordre des tableaux?

C'est dire que je voudrais :
Arles
Tarascon
Vieux port
Huveaune

Je vais essayé en changeant la lecture du tableau !!!
Merci...d'avance

 

[job75]

Re : Macro: deplacer tableau excel

Re,

Le 2ème problème est nettement moins évident, mais je regarde.

Notez que j'ai fait une modif pour simplifier le calcul de la variable lig.

A+

 

[pael]

Re : Macro: deplacer tableau excel

J'essaye :

je fais une boucle pour lire ma 1er serie :
J'ai 4 tableaux de 4 colonnes + les espaces :
For col = 1 To 20
à l'intérieur de cette boucle :
J'essaye de copier : 1-5 en 1er, 11-15 en second, 6-10 en 3eme et 16-20 en dernier.

Ca bug un peu chez moi

 

[job75]

Re : Macro: deplacer tableau excel

Re,

Ci-joint la macro modifiée (en rouge) et le fichier.

Pour que tous les tableaux soient copiés, il faut que le nombre de tableaux soit un multiple de 4 (ce n'est pas le cas du fichier, il y en a 6).

Sub Résultat()
Dim col As Integer, lig As Long, h As Byte
Application.ScreenUpdating = False
With Sheets("Résultat")
  .Range("A:D").Clear
  lig = 2
  For col = 1 To 5 * Application.CountA(Range("2:2")) / 3 - 4 Step 5
    h = Cells(20, col + 1).End(xlUp).Row - 1
    Cells(2, col).Resize(h, 4).Copy .Cells(lig, 1)
    lig = lig + h + 1
    [COLOR="Red"]If col Mod 20 = 1 Then
      col = col + 5
    ElseIf col Mod 20 = 6 Then
      col = col + 10
    ElseIf col Mod 20 = 16 Then
      col = col - 15
    End If[/COLOR]
  Next
  .Activate
End With
End Sub

A+

 

[pael]

Re : Macro: deplacer tableau excel

Parfait ,
C'est exactement ça !!!
la classe !!!

Je vais l'analyser pour mieux comprendre chaque fonctionnalité de la macro!!!

Merci

 

[pael]

Juste pour comprendre

re,

Juste pour comprendre:

tu fais varier la variable "col" --> For col = 1 To 5

Mais une fois que tu rentres dans le modulo :
If col Mod 20 = 1 Then
col = col + 5

La variable "col" est déjà égal à 6 au 1er tour? non?

 

[job75]

Re : Macro: deplacer tableau excel

Re,

Hum pael... col est égal à 1 au 1er tour, 6 au 2ème, 11 au 3ème...

Mais voici une autre version, à mon avis plus simple et plus souple.

Dans tablo, on indique l'ordre de lecture des tableaux (ligne en rouge).

J'ai rajouté 2 tableaux pour avoir un multiple de 4.

Sub Résultat()
Dim tablo(), i As Integer, j As Byte, col As Integer, lig As Long, h As Byte
Application.ScreenUpdating = False
[COLOR="Red"]tablo = Array(1, 11, 16, 6) '1ères colonnes des 4 premiers tableaux dans l'ordre de lecture[/COLOR]
With Sheets("Résultat")
  .Range("A:D").Clear
  lig = 2
  For i = 0 To 20 * Application.CountA(Range("2:2")) / 12 - 20 Step 20 '12 = nombre de valeurs en ligne 2 des 4 tableaux
    For j = 0 To 3
      col = i + tablo(j)
      h = Cells(20, col + 1).End(xlUp).Row - 1
      Cells(2, col).Resize(h, 4).Copy .Cells(lig, 1)
      lig = lig + h + 1
    Next
  Next
  .Activate
End With
End Sub

A+