VBA - BOUCLES / Copie et transposition de données
Bonjour à tous,
Pour mon premier post (et sûrement pas le dernier... :/) je vais introduire un peu l'objet de ma venue ici.
Je suis actuellement en fin d'études et ai donc à rédiger un mémoire. Le thème choisi a été la gestion du stress. Afin de pousser davantage la recherche, un protocole d'expérimentation a été mis en place pour induire un stress lié à un surcharge mentale (accumulation d'informations).
Je travaille avec Eprime2 habituellement, qui me ressors directement les données des expériences sous un format exploitable. Le problème est qu'il y a récemment eu un "kwak" et je me retrouve avec des formats txt inexploitables dans l'état actuel des choses.
Sachant que chaque txt passé et converti sous excel compte plus de 14000 lignes, à raison de 3 sujets, je vous laisse imaginer comment faire la chose à la main...
L'expérience se décompose en 2 cycles comprenant chacun 129 "niveaux".
Le premier cycle commence systématiquement à la ligne 361 quel que soit l'individu (1,2,3 ou 4)
Celui-ci se termine en ligne 7325
Le second commence en ligne 7335 et se termine en 14299.
Chaque "niveau" est caractérisé par des données étalées sur 53 lignes (-2 avec les lignes LOG FRAM non utilisées en début et fin de niveau), soit 51 lignes de données
J'ai détaille un peu la chose dans la feuille du premier individu.
Ce que j'aimerais faire serait automatiser la sélection des 51 lignes de résultats pour les copier/coller dans l'onglet des résultats "RECAP", et créer une boucle pour exploiter tous les résultats par individu pour les 129x2 niveaux.
J'ai essayé plusieurs macros (j'ai découvert les Macro et VBA il y a 2 heures...) :
- Copier / coller, supprimer la sélection précédente pour ensuite sélectionner les données suivantes et les coller, sauf que ça me supprimait dans RECAP systématiquement les données précédemment collées...
- Enregistrement d'une macro pour sélectionner les données voulues et les copier dans la feuille de "RECAP" mais je reste bloqué à ce stade, et j'ai du mal à m'y retrouver bien que j'ai consulté pas mal de topics ici...
- Je vous joint le fichier .Xls en question (avec la dernière macro utilisée, ne fonctionnant que pour le premier niveau de l'individu 1...).
Si quelqu'un pouvait me donner quelques pistes et conseils, je serais preneur !!!
Merci d'avance pour l'aide que vous pourriez m'apporter
Alex, et son mémoire qui est au point mort
Bonjour Alex_Cqn
Pas trop compris ce qu'il fallait restituer en feuille "RECAP"
Je n'ai traité que la feuille "INDIVIDU 1"
Faut-il boucler sur toutes les feuilles
Dans ton cas, j'ai recherché la chaîne "LogFrame" en colonne 2 à partir de la ligne 361 pour définir les différentes zones à copier.
Option Explicit
Sub test()
Dim myAreas As Areas, myArea As Range, n As Long
With Sheets("INDIVIDU 1").Range("b361:b14299")
Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas
'.ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Select
End With
n = 1
For Each myArea In myAreas
If myArea.Rows.Count = 51 Then
n = n + 1
With Sheets("RECAP")
.Cells(n, 2).Resize(1, myArea.Rows.Count).Value = Application.Transpose(myArea.Value)
End With
End If
Next
End Sub
Tu peux visualiser les différentes lignes à copier en exécutant ce code
Sub test1()
Dim myAreas As Areas, myArea As Range, n As Long
With Sheets("INDIVIDU 1").Range("b361:b14299")
Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas
'.ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Select
.Interior.ColorIndex = xlNone
End With
n = 1
For Each myArea In myAreas
If myArea.Rows.Count = 51 Then
myArea.Interior.ColorIndex = 43
End If
Next
End Sub
klin89
Bonjour et bienvenue sur le forum
Bonjour à tous
Un essai à tester.
Pour l'essai, j'ai reporter les données de la feuille du premier individu sur celles des 3 autres.
Cela te convient-il ?
Bye !
Bonsoir à tous les deux et merci beaucoup pour votre aide !
Je conçois que ma demande n'était pas forcément très claire, mais Klin89 a su résoudre une bonne partie de mon problème.
Merci également à toi gdb de t'être penché sur mon soucis
J'ai donc utilisé la macro proposée par Klin en l'appliquant aux différents individus (j'ai "bidouillé" pour la dériver afin de créer une macro par individu qui redirigerait ensuite les résultats vers une page récapitulative par résultat
Ensuite à la main pour copier les résultats des 4 feuilles "RECAP" dans la feuille "RECAP TOTALE"
Comme je l'ai dit, ça reste du bidouillage, mais j'ai réussi à aller où je voulais. Toujours est il que je serais curieux de savoir s'il aurait été possible de faire une seule macro pour récupérer toutes les données des 4 individus pour directement les mettre dans une seule et même feuille de recap total.
De même, y a t il un endroit sur le forum où je pourrais trouver les significations de tous les termes utilisés dans les macros que vous m'avez envoyé histoire de comprendre exactement comment l'on arrive à ce résultat ?
Quoi qu'il en soit, merci infiniment, vous m'avez déjà enlevé une belle épine (ou plutôt une hallebarde) du pied !!
Je vous joint le fichier que je viens de finaliser en format compressé.
Bonne soirée ,
Alex
Re Alex_Cqn
salut gmb
Option Explicit
Sub test()
Dim myAreas As Areas, myArea As Range, n As Long, ws As Worksheet
n = 1
For Each ws In Worksheets
If ws.Name <> "RECAP" Then
With ws.Range("b361:b14299")
On Error Resume Next
Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas
If Err Then GoTo 1
End With
If Not myAreas Is Nothing Then
For Each myArea In myAreas
If myArea.Rows.Count = 51 Then
n = n + 1
With Sheets("RECAP")
.Cells(n, 2).Resize(1, myArea.Rows.Count).Value = Application.Transpose(myArea.Value)
End With
End If
Next
End If
End If
1: On Error GoTo 0: Set myAreas = Nothing
Next
End Sub
ou celle-ci :
Sub test()
Dim myAreas As Areas, myArea As Range, n As Long, ws As Worksheet
n = 1
For Each ws In Worksheets
If ws.Name <> "RECAP" Then
With ws.Range("b361:b14299")
On Error Resume Next
Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas
End With
If Err = 0 Then
For Each myArea In myAreas
If myArea.Rows.Count = 51 Then
n = n + 1
With Sheets("RECAP")
.Cells(n, 2).Resize(1, myArea.Rows.Count).Value = Application.Transpose(myArea.Value)
End With
End If
Next
End If
On Error GoTo 0: Set myAreas = Nothing
End If
Next
End Sub
klin89
Bonjour bonjour !
Je n'ai pas réussi à avoir le résultat escompté avec les deux dernières macros que tu m'as envoyées.
Du coup avec quelques recherches et deux trois "bidouilles" j'ai réussi à automatiser ma requête grâce à ce que vous avez pu tous deux me fournir.
J'ai donc mis un bouton "LAUNCH" en haut à gauche de la première feuille de calcul, qui va exécuter le déplacement des données vers les 4 feuilles de récap puis transférera tout cela dans la première feuille de calcul !
Ca m'avance beaucoup, merci encore !
Bonne journée !
Bonjour à tous
Je ne vois pas ce qui cloche dans la première propositionque j'ai envoyée.
Elle est faite pour mettre en un clic sur la feuille RECAP les données des 4 individus dont les feuilles suivent.
J’ai repris ce fichier en y remplaçant les données de ces 4 individus par celles du dernier fichier que tu as joint et cela a encore l’air de marcher, du moins sur mon fichier : voir PJ
Bye !
Re Alex,
La restitution s'effectue en feuille "RECAP" et non "RECAP TOTAL"
Cela fonctionne dans tous tes fichiers joints
klin89
Klin89 a écrit :La restitution s'effectue en feuille "RECAP" et non "RECAP TOTAL"
Si c'est que ça, il suffit de Remplacer le nom RECAP par RECAP TOTAL en tout début de macro :
Sub Recap()
Application.ScreenUpdating = False
Set fr = Sheets("RECAP")
...
Bye !