Transformer une colonne en plusieur

Bonjour,

Tout d'abord je tiens à signaler que je connais pas le langage VBA mais je connais d'autre langage.

Après de nombreuses recherches avec de multiples mots pour trouver ce que je recherche je viens demandé ici.

Voila ce que j'aimerais faire :

J'ai un fichier de test qui regroupe pleins de tests pour pleins de modules ligne par ligne. j'aimerais copier en une colonne par module les valeurs mesurés. j'arrive à trier par module puis par test ensuite je supprime les colonnes qui ne m'interressent pas afin de garder que le module et ces mesures associé formant du coup 1 colonne. j'ai mis / signifiant colonne et voic mon premier bout de code pour trier et supprimer. et en dessous un exemple. La finalité ensuite est de copier toutes ces colonnes dans un autre fichier excel ou j'ai fait plein de formule conditionnelle ou l'on peut à l'aide de couleur traduire les résultats facilement.

Sub Trie()

With Range("A1:I400000")

.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess

.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess

End With

Range("A1").Select

Columns("B:D").Delete Shift:=xlToLeft

End Sub

Exple

Module1 / Test1 /Valeur min /valeur max /mesure1

Module1 / Test2 /Valeur min /valeur max /mesure2

Module1 / Test3 /Valeur min /valeur max /mesure3

Module2 / Test1 /Valeur min /valeur max /mesure1

Module2 / Test2 /Valeur min /valeur max /mesure2

Module2 / Test3 /Valeur min /valeur max /mesure3

Etc....

J'aimerais en vba faire ceci

Module1/ Module2/ Module3

mesure1/ Mesure1/ Mesure1

Mesure2/ Mesure2/ Mesure2/

mesure3/ Mesure3/ Mesure3/

etc.../ etc.../ etc.../

Merci pour votre temps!

Voici les 2 fichiers. le fichier "mesure" est celui que j'importe ou tous les résultats sont les un après les autres. le second fichier "Releve" est celui qui me permet de faire des stats.

A chaque fois je fais copier/coller dans les colonnes du fichiers relevé. mon problème c'est que j'ai un nombre de module très très élevé et avec 1200 mesure pour chaque relevé.

Il faut savoir qu'en faite le nom "module1" est aléatoire car en principe c'est un date code. (Identique pour chaque mesure)

Il n'y a pas forcement toute les mesures effectués par module car cela prend 40 min alors généralement il arrête le test si il n'ont pas le temps.

Est il réalisable de faire cela en automatique?

merci

9mesure.zip (6.40 Ko)
12releve.xlsx (20.80 Ko)

Bonjour

Un essai

Cela correspond bien a ce que je veux mais sur mon fichier original cela ne marche.

Je pense en regardant le code que c'est du au faite qu'il y a écrit "mesure" comme variable a un moment. le nom que j'ai mit : mesure1 à mesure100 était un nom aléatoire en faite je fais au maximun 1215 mesures mais avec des noms differents par exemple mesure1 etait "température" en faite.

voici un exemple

fichier fourni Module1 / Mesure1 / valeur min / valeur max / valeur trouve

fichier réel

89360 / température / 20 / 30 / 25

89360 / VDD1 / 4.9 / 5.1 / 5.0

etc...

Le point commun est le nom du Module. Et sur ce module il peut il y a avoir de 1 à 1215 mesures rangé toujours dans le meme ordre.

En langage c j'aurais fait

i=1; J=1;

tant que Texte colonneA / ligne i = Texte colonneA / ligne i+ 1;

alors J = J + 1 i= i + 1

comme cela on connait le nombre de ligne à copier en J.

On coupe les ligne de 1 à j dans l'autre fichier avec incrementation d'une variable pour la position de la colonne puis on recommence.

Mais quand je regarde le code VBA il va me falloir des semaines pour tout comprendre. les commandes en vba ne sont pas très intuitif quand on ne connait pas. Pensez-vous que la façon dont je parle est possible du coup ?

Bonjour

La macro est adaptée au fichier que tu as posté

La macro utilise les entêtes des colonnes pour filtrer et pour recopier les infos au bon endroit

Ce que je comprends c'est que le boulot que j'ai fait ne va pas servir

Il est impératif d'avoir les bonnes infos

Il ne te reste plus qu'à renvoyer des fichiers reflétant la réalité (sans garantie)

En faite je me suis embêté a tout renommer c'est parce que je ne peux pas fournir ces documents c'est pourquoi j'ai fait un exemple globale en précisant que les "module1" était un nom aléatoire correspond a un date code.

J'avais pas précisez que mesure1 etait aussi un équivalent. si tu veux je remplace tous les noms "module1" par un nom aléatoire et tous les mesure aussi par un nom aléatoire.

Au final je vais renommer tous les mesure1 en truc et mesure2 en machin et mesure3 en bidule afin de pas avoir d’incrément dans le noms puis tous les module 1 en 77320, module2 en 88620 et module3 en 5X224 afin de pas avoir vraiment d’incrément non plus.

Désole je pensais que je m’étais bien exprimé afin de partir dans la bonne direction. Veux-tu vraiment que je te renvoie les fichiers du coup ? je préférais prendre du temps à comprendre ce que tu as fait.

Merci quand même de m'avoir fait ce bout de vba au minimun je peux partir sur cette exemple pour apprendre si tu m'a pas le temps de le refaire.


Désolé je dois partir je reprendrais cela demain matin pas d'internet chez moi! je prends quand même ton code pour travaillé dessus à la maison! peut etre demain j'aurais réussi!

Bonsoir

2 conditions

Être sur que les mesures sont toujours dans le même ordre (dans ce cas plus besoin de trier)

Que les noms des entêtes de la page mesure soient identiques aux noms dans le fichier csv

Si c'est le cas tu supprimes cette partie

  With Sheets(Sheets.Count)
    .Name = "A effacer"
    NbLg = .Range("A" & Rows.Count).End(xlUp).Row
'    With .Range("F1:F" & NbLg)
'      .Formula = "=""Mesure""&TEXT(MID(B1,7,100)*1,""000"")"
'      .Value = .Value
'    End With
'
'    .Range("A1:F" & NbLg).Sort key1:=.Range("A1"), order1:=xlAscending, dataoption1:=xlSortNormal, _
'                               key2:=.Range("F1"), order2:=xlAscending, dataoption2:=xlSortNormal, Header:=xlNo

Bonjour,

Alors les mesures seront triées en premier toujours dans le même ordre. donc là pas de problème par contre les entêtes sont un date code que je ne peux pas connaitre, il y a que lorsque je reçois mon fichier que je connais le nom des modules donc il faut que je fasse une liste de tous les noms des modules pour les copier sur chaque entetes me donnant donc le nombre de colonne.... je vais essayé de ja en supprimant la partie que vous m'avez dit pour voir si le probleme des noms "mesure" marche et ensuite j'essaie de faire un bout de code.

merci

Merci cela marche pour le nom des mesures il y a juste un petit soucis car le nombre des colonnes est défini alors qu'il peux y en avoir beaucoup plus il faudrait que j'arrive à modifier 19 par le nombre de colonne exacte.

Une possibilité : sur la colonne ou j'ai tous mes noms de modules :

  • Copie de la colonne module dans une nouvelle feuille
  • suppression de tous les doublons de cette colonne
  • transposition colonne en ligne
  • du coup j'obtiens le nombre de colonne et tous mes entetes que je recopie sur ma feuille résultat

A votre avis c'est jouable ?

With Sheets(Sheets.Count)

.Name = "A effacer"

NbLg = .Range("A" & Rows.Count).End(xlUp).Row

.Columns("C:E").Replace what:=".", replacement:=".", lookat:=xlPart

.Rows(1).Insert

For Colonne = 4 To 19

.Range("A1:E" & NbLg).AutoFilter field:=1, Criteria1:=F1.Cells(8, Colonne)

If Application.Subtotal(103, .Columns(1)) > 0 Then

.Range("E2:E" & NbLg + 1).SpecialCells(xlCellTypeVisible).Copy F1.Cells(9, Colonne)

End If

Next Colonne

Application.DisplayAlerts = False

.Delete

Application.DisplayAlerts = True

End With

Bonjour

faz a écrit :

A votre avis c'est jouable ?

A mon avis cela peut fonctionner mais tu en sauras un peu plus une fois que tu l'auras testé

Mais pas la peine de passer par une autre feuille restes sur la feuille "A effacer"

J'ai réussi à bien avancer en fin ça marche mais je ne sais pas si il y a pas de faute étant donné que j'y suis allé au pif donc il y a surement des redondances et des choses inutile. sinon j'ai quand même passé ma journée dessus en ayant tout perdu dans l'apres midi car le code est lié au fichier excel et du coup je voulais garder mon fichier excel d'origine et cela m'a supprimé tout ce que j'avais fait depuis des heures! c'est compliqué vba il y a different facon de faire la m^me chose je n'ai pas réussi à comprendre comment vous faite à la fin pour copier les colonne en fonction des entetes!

merci en tous cas car cela m'a permis au moins de faire cela!

en vert c'est une partie que j'ai rajouté pour trier et avoir le fichier comme celui que j'ai envoyé au début. a supprimer

en bleu c'est de la copie de formule et mise en forme

Option Explicit

Sub Importation()

Dim Chemin As String, Fichier As String

Dim Wb As Workbook

Dim F1 As Worksheet ', F2 As Worksheet

Dim NbLg As Long

Dim Colonne As Integer

Dim dercol As Integer

dercol = Cells(8, Columns.Count).End(xlToLeft).Column 'calcul de nombre de colonne dans le fichier résultat pour les effacer toutes

Range(Cells(5, 5), Cells(2000, dercol)).ClearContents

Application.ScreenUpdating = False

Set F1 = ActiveSheet

On Error Resume Next

Application.DisplayAlerts = False

Sheets("A effacer").Delete ' On efface cette page au cas ou

Application.DisplayAlerts = True

On Error GoTo 0

Chemin = ThisWorkbook.Path & Application.PathSeparator

ChDir Chemin

Fichier = Application.GetOpenFilename("Fichier csv (*.csv),*.csv")

If Fichier <> "Faux" Then

Workbooks.OpenText Filename:=Fichier, DataType:=xlDelimited, Tab:=False, semicolon:=False, comma:=True, Space:=False, other:=False, local:=True

Sheets.Add.Move After:=Sheets(Sheets.Count) 'création d'une nouvelle feuille pour les entetes

Sheets(Sheets.Count).Name = "entete"

Sheets("mesures").Select

Cells.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Cells.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Columns("A:B").Delete Shift:=xlToLeft

Columns("B").Delete Shift:=xlToLeft

Columns("F").Delete Shift:=xlToLeft

Columns("C").Select

Selection.Copy

Range("F1:F1").Select

ActiveSheet.Paste

Columns("C").Delete Shift:=xlToLeft

Columns("A").Select 'copie et collage des entetes sur la nouvelle feuille avec supression doublon trie et transposage en 1 ligne

Selection.Copy

Sheets("entete").Select

Range("A1:A1").Select

ActiveSheet.Paste

ActiveSheet.Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo

Cells.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Selection.Sort Key1:=Range("A1")

Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Copy

Range("B1").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=True

Application.CutCopyMode = False

Columns("A:A").Delete Shift:=xlToLeft

dercol = Cells(1, Columns.Count).End(xlToLeft).Column 'compte le nbre de colonne d'entete et ajout de 3 pour le fichier résultat

dercol = dercol + 3

Set Wb = ActiveWorkbook

With Wb

.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

.Sheets(2).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

.Close False

End With

End If

Sheets("entete").Select 'selection entete sur fichier résultat copy des entete sur page principal et supression feuille entete

Rows(1).SpecialCells(xlCellTypeConstants, 23).Copy

Sheets("mesure").Select

Range("D8").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False

Application.DisplayAlerts = False

Sheets("entete").Delete

Application.DisplayAlerts = True

Range("D9:D9").Select

Selection.Copy

Range(Cells(9, 4), Cells(2000, dercol)).Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("D5").Select

Selection.Copy

Range(Cells(5, 4), Cells(5, dercol)).Select

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

With Sheets(Sheets.Count)

.Name = "A effacer"

NbLg = .Range("A" & Rows.Count).End(xlUp).Row

.Columns("C:E").Replace what:=".", replacement:=".", lookat:=xlPart

.Rows(1).Insert

For Colonne = 4 To dercol

.Range("A1:E" & NbLg).AutoFilter field:=1, Criteria1:=F1.Cells(8, Colonne)

If Application.Subtotal(103, .Columns(1)) > 0 Then

.Range("E2:E" & NbLg + 1).SpecialCells(xlCellTypeVisible).Copy F1.Cells(9, Colonne)

End If

Next Colonne

Application.DisplayAlerts = False

.Delete

Application.DisplayAlerts = True

End With

End Sub

Dans le principe et pour mon fichier cela marche donc je valide mais il y a peut etre des erreurs dans ce code que je n'ai pas vu!

Rechercher des sujets similaires à "transformer colonne"