XL 2016 Décaler courbes sur l'abscisse puis créer une moyenne

Oliroul

XLDnaute Nouveau
Bonjour,
A peine inscrit, je poste déjà mon problème car je ne m’en sort pas, c'est aussi pour cela que je me suis inscrit ;)

Dans mon cas, j’importe des fichiers txt, je les mets en formes pour tracer les courbes correspondantes pour les comparer et tracer une courbe moyenne

Mais chaque fichier a une abscisse de temps différentes, donc je ne peux pas faire la moyenne directement.

Et donc je souhaite sur une même feuille importer les valeurs recalées de sorte à ce que mes courbes soient comparables. Le recalage se fait par le maxi sur une échelle de temps centrée sur zéro [-0,5000 ; 0,5000].

J’arrive a trouver la valeur Max, mais il y a peut-être plus simple. Ce que je n’arrive pas à faire c’est copier vers le haut pour que mon max trouvé corresponde au zéro de la nouvelle feuille « Courbes_recalées »

Concernant la moyenne, je souhaite laisser le choix à l’utilisateur des colonnes à moyenner, pour l’exemple, je l’ai fait « à la mano » dans Excel

J’ai créé un fichier d'exemple que j'ai été obligé d'alléger (les courbes sont des captures pour gain de place) pour expliciter ce que je souhaite, vu le temps que j'ai mi pour 3 courbes j'espère que c'est assez clair.

Pour info, à termes, je souhaite importer 24 courbes et faire 4 moyennes

Merci pour votre aide, en espérant que ma demande ne soit pas irréalisable
 

Pièces jointes

  • Recalage.xlsm
    722.6 KB · Affichages: 16
Solution
Bonjour Oliroul, le forum,

Avec ce fichier (2) on crée en plus les graphiques des courbes sélectionnées :
VB:
Dim graph As Boolean 'mémorise la variable

Sub Graphiques()
'se lance par les touches Ctrl+G
graph = True: Moyenne: graph = False
End Sub

Sub Moyenne()
'se lance par les touches Ctrl+M
Dim P As Range, rc&, cc%, col%
Set P = Union(Columns(1), Selection.EntireColumn)
Application.ScreenUpdating = False
'---copier-coller---
With Workbooks.Add(xlWBATWorksheet).Sheets(1) 'nouveau document
    P.Copy .[A1]
    .[A1].Copy .[A1] 'allège la mémoire
    Set P = .UsedRange
    rc = P.Rows.Count: cc = P.Columns.Count
    If rc = 1 Or cc = 1 Then .Parent.Close False: Exit Sub 'sécurité
    .Name = "Moyenne"
End With
'---colonnes Real time et...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re, Bonsoir Job
Je suis sceptique sur votre fichier de 15Mo.
En PJ la même version avec 70 courbes et je reste sous la barre fatidique des 1Mo de XLD pour les PJ.

Si pas de données sensibles, envoyez votre fichier de 15Mo par ce site : https://www.cjoint.com/
Je pense qu'il y a un truc mais j'aimerais comprendre lequel. :)
 

Pièces jointes

  • Recalage_Light_binaire_sans_graphique2.xlsb
    960.8 KB · Affichages: 17
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Oliroul, sylvanu,

Voyez le fichier joint avec 12 colonnes pour 12 courbes, il pèse 433 Ko.

Avec 80 colonnes et 5000 lignes ce fichier peut atteindre chez moi 3 Mo.

Pour éviter qu'il prenne du poids il suffit d'utiliser de nouveaux documents vierges.

Par exemple comme le fait cette macro pour le calcul de la courbe Moyenne :
VB:
Sub Moyenne()
'se lance par les touches Ctrl+M
Dim P As Range, rc&, cc%
Set P = Union(Columns(1), Selection.EntireColumn)
Application.ScreenUpdating = False
'---copier-coller---
With Workbooks.Add(xlWBATWorksheet).Sheets(1) 'nouveau document
    P.Copy .[A1]
    .[A1].Copy .[A1] 'allège la mémoire
    Set P = .UsedRange
    rc = P.Rows.Count: cc = P.Columns.Count
    If rc = 1 Or cc = 1 Then .Parent.Close False: Exit Sub 'sécurité
    .Name = "Moyenne"
End With
'---colonnes Real time et Moyenne---
With P(1, cc + 1)
    .Resize(, 2) = Array("Real time", "Moyenne")
    .Resize(, 2).Font.Bold = True
    .Resize(, 2).Font.ColorIndex = 3 'rouge
    .Cells(2, 2).Resize(rc - 1) = "=AVERAGE(RC2:RC[-2])"
    .Cells(2).Resize(rc - 1) = "=RC1-INDEX(C1,MATCH(MAX(C[1]),C[1],0))"
End With
'---graphique---
With P.Parent.ChartObjects.Add(0, 50, ActiveWindow.VisibleRange.Width, 400).Chart
    .ChartType = xlXYScatterLinesNoMarkers
    .SetSourceData P(1, cc + 1).Resize(rc, 2)
End With
Application.ScreenUpdating = True
End Sub
Elle se lance par les touches Ctrl+M.

Le document créé peut être enregistré ou non.

A+
 

Pièces jointes

  • Moyenne(1).xlsm
    433.2 KB · Affichages: 3
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Oliroul, le forum,

Avec ce fichier (2) on crée en plus les graphiques des courbes sélectionnées :
VB:
Dim graph As Boolean 'mémorise la variable

Sub Graphiques()
'se lance par les touches Ctrl+G
graph = True: Moyenne: graph = False
End Sub

Sub Moyenne()
'se lance par les touches Ctrl+M
Dim P As Range, rc&, cc%, col%
Set P = Union(Columns(1), Selection.EntireColumn)
Application.ScreenUpdating = False
'---copier-coller---
With Workbooks.Add(xlWBATWorksheet).Sheets(1) 'nouveau document
    P.Copy .[A1]
    .[A1].Copy .[A1] 'allège la mémoire
    Set P = .UsedRange
    rc = P.Rows.Count: cc = P.Columns.Count
    If rc = 1 Or cc = 1 Then .Parent.Close False: Exit Sub 'sécurité
    .Name = "Moyenne"
End With
'---colonnes Real time et Moyenne---
With P(1, cc + 1)
    .Resize(, 2) = Array("Real time", "Moyenne")
    .Resize(, 2).Font.Bold = True
    .Resize(, 2).Font.ColorIndex = 3 'rouge
    .Cells(2, 2).Resize(rc - 1) = "=AVERAGE(RC2:RC[-2])"
    .Cells(2).Resize(rc - 1) = "=RC1-INDEX(C1,MATCH(MAX(C[1]),C[1],0))"
End With
'---graphique(s)---
With P.Parent.ChartObjects.Add(0, 50, ActiveWindow.VisibleRange.Width, 400).Chart
    .ChartType = xlXYScatterLinesNoMarkers
    .SetSourceData P(1, cc + 1).Resize(rc, 2)
End With
If graph Then
    For col = 2 To cc
        If P(1, col) <> "" Then
            Sheets.Add After:=ActiveSheet
            ActiveSheet.Name = P(1, col)
            P.Columns(1).Copy Cells(1)
            P.Columns(col).Copy Cells(1, 3)
            Cells(2, 2).Resize(rc - 1) = "=RC1-INDEX(C1,MATCH(MAX(C[1]),C[1],0))"
            Cells(1, 2) = "Real time"
            Cells(1, 2).Font.Bold = True
            With ActiveSheet.ChartObjects.Add(0, 50, ActiveWindow.VisibleRange.Width, 400).Chart
                .ChartType = xlXYScatterLinesNoMarkers
                .SetSourceData Cells(1, 2).Resize(rc, 2)
            End With
        End If
    Next
    P.Parent.Activate
End If
Application.ScreenUpdating = True
End Sub
A+
 

Pièces jointes

  • Moyenne(2).xlsm
    435 KB · Affichages: 7
Dernière édition:

Oliroul

XLDnaute Nouveau
Bonjour,

Merci pour vos retour. Je sens qu'on (enfin surtout vous) approche du but.

J'ai copié les vraies valeurs dans le fichier joint avec les vrais noms et ça a l'air de fonctionner, avec 2 onglets de plus j'arrive à un fichier de 2 Mo, c'est plus qu'acceptable.

J'aime bien l'idée de la liste, c'est bien visuel.

Il faut encore que je fasse tester le fichier à l'utilisateur final (qui s'y connaît moins que moi, c'est pas peu dire...).

J'aimais bien l'idée de créer un fichier séparé, mais ça risque de multiplier les fichiers. Charge à l'utilisateur de sauvegarder ses courbes moyennées

Encore merci pour tout.

Je clôturerai la discussion après quelques tests.
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa