Superposer deux plages/colonnes

[Sydney]

Bonjour,

J'ai un tableau qui se presente comme dans la feuille1 du fichier exemple ci-joint, ou il y a un premier groupe de colonnes (y, z) sous un ensemble A et un deuxieme groupe (y, z) sous un ensemble B. Chaque colonne comporte des donnees aleatoires. Seule la colonne x en debut de tableau est fixe avec ses donnees classees par ordre croissant.

Dans une feuille2, je souhaiterais superposer les colonnes des ensembles A et B pour obtenir un resultat similaire a ce que j'ai mis dans la feuille2 du fichier joint. Ainsi il y a une colonne x contenant tous les xA et xB, une colonne y contenant tous les yA et yB, ect.
En plus, je voudrais inserer une colonne H entre les colonnes x et y qui reprendrait le nom de l'ensemble (A ou B) d'ou sont tirees les donnees de la ligne.

Le plus complique etant que le nombre de lignes en feuille1 peut varier (mais il y a toujours le meme nombre de lignes pour chaque ensemble A et B).

Existe-t-il un moyen en VBA de realiser ces operations? C'est surtout l'ajout de la colonne H et le nombre variable de lignes qui me posent probleme.

Sydney

 

[Gael]

Re : Superposer deux plages/colonnes

Bonjour Sydney,

Essaye la macro suivante qui va créer le tableau souhaité quel que soit le nombre de lignes et le nombre d'ensembles à traiter mais avec un groupe de colonnes fixe égal à 2 pour chaque ensemble.

Le résultat s'écrit en cellule C12 mais tu peux changer l'emplacement.

Sub test()
Dim tablo As Variant
Dim Newtab()
Dim i As Integer, j As Integer, l As Integer
tablo = ActiveSheet.Range("C6").CurrentRegion
ReDim Newtab((UBound(tablo) - 2) * 2 + 1, (UBound(tablo, 2) - 1) / 2 + 2)
Newtab(0, 0) = tablo(2, 1)
Newtab(0, 1) = "H"
Newtab(0, 2) = tablo(2, 2)
Newtab(0, 3) = tablo(2, 3)
l = 1

For i = 2 To UBound(tablo, 2) Step 2
    For j = 3 To UBound(tablo)
        Newtab(l, 0) = tablo(j, 1)
        Newtab(l, 1) = tablo(1, i)
        Newtab(l, 2) = tablo(j, i)
        Newtab(l, 3) = tablo(j, i + 1)
        l = l + 1
    Next j
Next i
Range("C12").Resize(UBound(Newtab), UBound(Newtab, 2)) = Newtab
End Sub

@+

Gael

 

[Sydney]

Re : Superposer deux plages/colonnes

Bonjour Gael,

merci pour ta macro. Elle fonctionne tres bien. Le hic c'est que le tableau sur lequel je travaille reellement est un peu plus complexe que celui que j'ai mis en exemple. Il faut donc que j'adapte certains points de la macro. Or, pour etre franc, ta macro va bien au-dela de mes competences et je ne suis pas sur de pouvoir l'adapter a mes besoins. Je sais pas utiliser les fonctions ReDim et UBound Si quelqu'un a le temps, je veux bien une rapide explication

J'ai trouve une methode, beaucoup moins fine que la tienne, qui consiste tout simplement a copier un grand nombre de lignes pour chacun des ensembles (j'ai place ce nombre a 20 dans la macro ci-dessous, mais en realite j'utilise 1000 car mon tableau est assez grand), puis a supprimer les lignes "vides"

Ca donne ca:

Sub superposer_colonnes()
 
Cells.Select
Selection.Delete Shift:=xlUp
 
'copy/paste from sheet1
Worksheets("Sheet1").Select
Range("C5:E20").Select
Selection.Copy
Worksheets("Sheet3").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
 
Worksheets("Sheet1").Select
Range("C6:C20").Select
Selection.Copy
Worksheets("Sheet3").Select
Range("A40").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Worksheets("Sheet1").Select
Range("F6:G20").Select
Selection.Copy
Worksheets("Sheet3").Select
Range("B40").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
 
'insert H column
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select
ActiveCell.FormulaR1C1 = "H"
Range("B2:B39") = "A"
Range("B40:B60") = "B"
 
'delete empty rows
Dim i As Integer
For i = 1 To 100
If (Cells(i, 1) = "") And (Cells(i, 2) = "A") Or (Cells(i, 1) = "") And (Cells(i, 2) = "B") Then
Cells(i, 1).EntireRow.Delete
i = i - 1
End If
Next
 
End Sub

C'est pas tres beau a voir, mais bon...

 

[Gael]

Re : Superposer deux plages/colonnes

Bonjour Sydney, bonjour à tous,

Il n'y a pas beaucoup de mystère ni de complexité dans ces instructions. La macro tavaille avec des tables en mémoire puis écrit le résultat à l'endroit souhaité.

J'utilise 2 tables, l'une contenant les données de départ et l'autre correspondant à la nouvelle présentation souhaitée.

1 - L'instruction

tablo = ActiveSheet.Range("C6").CurrentRegion

permet de mettre en mémoire les données initiales. Chaque donnée peut être lue en faisant référence à sa position (ligne, colonne). L'intérêt du "Currentregion" est de sélectionner automatiquement l'ensemble du tableau délimité par une ligne et une colonne vide (de la même façon que "données - trier").

2 - Le "Redim" sert à dimensionner la nouvelle table en fonction des données initiales en lui donnant le nombre de lignes et de colonnes nécessaires.
"Ubound" permet de connaître une dimension d'un tableau (nbre de lignes ou colonnes) ce qui est très utile dans ce cas puisque le tableau initial est créé avec le "Currentregion" dont on ne connaît pas les limites exactes.

Nbre de lignes de la nouvelle table=Nbre de lignes de l'ancienne table - les lignes d'entête (soit: 1, 2, 3) * nombre de lettres (A,B), ce qui donne:

Ubound(tablo)-2 pour les lignes
((UBound(tablo, 2) - 1) / 2) pour les colonnes:
Nbre de colonnes initial (le ",2" indique que l'on veut le 2ème dimension du tableau soit le nbre de colonnes) -1 pour ne pas tenir compte de la première colonne et "/2" puisque chaque lettre comprend 2 colonnes.
et pour finir, on ajoute +1 pour avoir une ligne de titres.

Nbre de colonnes de la nouvelle table:4

Soit finalement (l'instruction est un peu différente de mon exemple précédent pour s'adapter à tous les cas).

ReDim Newtab((UBound(tablo) - 2) * ((UBound(tablo, 2) - 1) / 2) + 1, 4)

Le reste de la macro recopie simplement les données dans la nouvelle table.

Cette macro va tenir compte du nombre de lettres (A,B,C,D...) comme du nombre de lignes différentes (1,2,3,4,5...).

Si pour chaque lettre, tu as plus de colonnes (ex: y,z,t), il faudra mettre "/3" au lieu de "/2" et ",5" au lieu de ",4" dans le Redim

Dans la boucle, il faudra mettre "Step 3" pour aller de 3 colonnes en 3 colonnes pour le changement de lettre

Et enfin ajouter une nouvelle instruction de copie pour la colonne supplémentaire:

"Newtab(l, 4) = tablo(j, i + 2)"

J'espère que c'est un peu plus clair.

Tu peux m'envoyer un exemple avec la structure plus complexe et le résultat à obtenir, j'adapterai la macro.

@+

Gael

 

[Sydney]

Re : Superposer deux plages/colonnes

Bonjour Gael, bonjour tout le monde,

Merci beaucoup d'avoir pris le temps de me repondre aussi precisement.
Je ne suis pas sur de pouvoir refaire une telle macro moi-meme, mais grace a tes explications j'ai pu l'adapter a mon tableau (dont le format reel est en piece jointe).

Sub test2()
Dim tablo As Variant
Dim Newtab()
Dim i As Integer, j As Integer, l As Integer
tablo = ActiveSheet.Range("A6").CurrentRegion
ReDim Newtab((UBound(tablo) - 2) * ((UBound(tablo, 2) - 4) / 7) + 1, 10)
Newtab(0, 0) = tablo(3, 3)
Newtab(0, 1) = tablo(3, 4)
Newtab(0, 2) = "H"
Newtab(0, 3) = tablo(3, 5)
Newtab(0, 4) = tablo(3, 6)
Newtab(0, 5) = tablo(3, 7)
Newtab(0, 6) = tablo(3, 8)
Newtab(0, 7) = tablo(3, 9)
Newtab(0, 8) = tablo(3, 10)
Newtab(0, 9) = tablo(3, 11)
l = 1

For i = 5 To UBound(tablo, 2) Step 7
    For j = 4 To UBound(tablo)
        Newtab(l, 0) = tablo(j, 3)
        Newtab(l, 1) = tablo(j, 4)
        Newtab(l, 2) = tablo(2, i)
        Newtab(l, 3) = tablo(j, i)
        Newtab(l, 4) = tablo(j, i + 1)
        Newtab(l, 5) = tablo(j, i + 2)
        Newtab(l, 6) = tablo(j, i + 3)
        Newtab(l, 7) = tablo(j, i + 4)
        Newtab(l, 8) = tablo(j, i + 5)
        Newtab(l, 9) = tablo(j, i + 6)
        l = l + 1
    Next j
Next i
Worksheets("Sheet2").Range("A1").Resize(UBound(Newtab), UBound(Newtab, 2)) = Newtab

Worksheets("Sheet2").Cells.Replace What:="A grp", Replacement:="A"
Worksheets("Sheet2").Cells.Replace What:="B grp", Replacement:="B"

End Sub

En fait, le tableau d'origine est dans un fichier different, donc j'ai remplace la phrase:

tablo = ActiveSheet.Range("A6").CurrentRegion

par

Windows("File1.xls").Activate
Worksheets("Sheet1").Select
tablo = Range("A6").CurrentRegion

Je n'ai pas trouve le moyen de mettre cette expression sur une seule ligne, du style:
tablo = Windows().Worksheets().Range().CurrentRegion

Sinon, est-il possible de preserver le format du tableau d'origine.
Par exemple, je voudrais garder la couleur de texte des cellules E6:R18 (pour les nombres en rouge ou orange).

Enfin, le nom des groupes dans le tableau d'origine est "A grp" et "B grp". J'ai utilise la formule de remplacement pour les changer en "A" et "B" dans le nouveau tableau, mais existe-il une fonction qui permettent d'effacer une partie du texte au moment de copier la cellule. Du style:
Newtab(l, 2) = tablo(2, i).text - " grp"

Merci encore pour ton aide.

Sydney

 

[Gael]

Re : Superposer deux plages/colonnes

Bonjour Sydney, bonjour à tous,

Si tu veux conserver les formats, il vaut mieux travailler avec des copier/coller plutôt que des tables en mémoire.

Essaye la procédure "Copie" dans l'exemple joint qui va créer le tableau dans une nouvelle feuille puis déplacer cette feuille dans un nouveau classeur.

@+

Gael

 

[Sydney]

Re : Superposer deux plages/colonnes

Bonjour Gael,

Merci pour ton aide. Ca marche tres bien.
Simplement, mon fichier d'origine contient des formules donc j'ai change la phrase

.Range("C5:E5").Copy Destination:=Worksheets("Newtab").Range("A1")

en

.Range("C5:E5").Copy: Worksheets("Newtab").Range("A1").PasteSpecial Paste:=xlPasteValues: Worksheets("Newtab").Range("A1").PasteSpecial Paste:=xlPasteFormats

@+
Sydney

 

[Damien FDAAPPMA82]

problème similaire

Bonjour, J'ai un problème similaire à la celui de cette discussion

J'ai récupéré des donnés de débit moyen journalier de l'Aveyron (cours d'eau du Tarn et Garonne) entre 1914 et 2015. Sur 4 stations dans le département. Ayant récupéré ces données sur Hydrofrance, les tableaux ne sont absolument pas exploitable en l’état. Apres une multitude d'infos supprimés j'arrive à des tableaux brut comme cela (voir tableau joint)

Alors que je souhaiterai avoir un tableau avec en colonne : | DATE | DEBIT | (voir tableau joint)

Etant donné que les tableaux sont lourd et que j'en ai 5 à mettre en forme. Je ne trouve pas de solution rapide pour acquérir cette mise en forme.

Suis-je obligé de tout faire à la main, ou connaissez vous une astuce pour aller plus rapidement ?

Je vous remercie d'avance du temps que vous accorderez à ma demande.

Cordialement,