Besoin d'aide - Suivi SPC

martial58

XLDnaute Junior
Bonjour à tous.

Dans le cadre de mon travail, nous devons réaliser un suivi SPC de deux postes de collage.

Deux fois par jour nous allons prélever 5 pièces collées que nous allons tester sur une machine de traction.

Cette machine permet l'exportation de chaque courbe d'arrachement au format .tra.
Ce fichier contient tous les points de la courbe avec diverses données: date de collage, n° de lot, etc...

Les courbes seront rangées dans un même dossier avec la même racine de nom + la date et le numéro d'éprouvette : MASTER SPC 1811101.TRA.

Je souhaiterais donc ,chaque jour, faire la moyenne et l'écart type de la valeur d'arrachement de chaque courbe pour une plage données, de 5 à 10 mm.

Il faut ensuite que je puisse faire la moyenne des 5 courbes et représenter dans un graphique cette courbe moyenne ainsi que les 5 moyennes représentées par des points.

L'exportation de toutes les données de chaque courbe dans un tableau, associées aux moyennes et écart type calculées, nous permettrait de réaliser des tris et des suivis en fonction du paramètre que l'on souhaite :machine, opérateur, lot ou autre.

Comment faire pour automatiser cette opération sous excel ?

Je joins à ce sujet le fichier .tra dont j'ai modifié l'extension en .xls pour pouvoir l'uploader.

Merci d'avance pour votre aide.
 

Pièces jointes

  • MASTER SPC 1811101.xls
    8.6 KB · Affichages: 149
Dernière édition:

martial58

XLDnaute Junior
Re : Suivi SPC de courbes d'arrachement.

Bonjour.

J'ai avancé au niveau de la macro.
J'arrive à récupérer les données de chaque courbe et à les placer dans un tableau.

Sub Importdonnées()

Application.ScreenUpdating = False
Nbcol = Range("A1").SpecialCells(xlCellTypeLastCell).Column - 1

chemin = "P:\Lots testés\Suivi SPC"
lig = 2
fich = Dir(chemin & "\*.tra")
nom:
ThisWorkbook.Sheets("PRESSAGE").Cells(lig, 1) = fich
fich = Dir
If fich <> "" Then
lig = lig + 1
GoTo nom
End If

For num = 2 To lig
Workbooks.Open chemin & "\" & ThisWorkbook.Sheets("PRESSAGE").Cells(num, 1)
For num2 = 1 To Nbcol
contenu = ActiveSheet.Cells(num2, 1)
pos = InStr(contenu, ";") + 2
texte = Mid(contenu, pos, Len(contenu) - pos)
ThisWorkbook.Sheets("PRESSAGE").Cells(num, num2 + 1) = texte
Next num2
ActiveWorkbook.Close
Next num

Application.ScreenUpdating = True
End Sub

Mon soucis maintenant est de calculer la moyenne et l'écart type de chaque courbe sur une plage de déplacement donné, disons 5 à 10 mm.

Il faut que j'ajoute les résultats du calcul sur deux nouvelles colonnes.
Avez-vous une idée ?

Merci.
 
Dernière édition:

martial58

XLDnaute Junior
Re : Suivi SPC de courbes d'arrachement.

Bonjour.

Il y a un exemple de fichier source dans le premier message.

Je viens de penser à une fonction qui pourrait simplifier du départ les choses, en scindant la colonne de chaque fichier .tra en deux colonnes suivant le séparateur ";".

Je travaille dessus.

Merci.
 

martial58

XLDnaute Junior
Re : Suivi SPC de courbes d'arrachement.

Bonjour.

Je n'arrive pas à déterminer les cellules de la colonne A comprise entre deux valeurs afin de faire la moyenne et l'écart type des valeurs correspondantes en colonne B.

Quelqu'un peut-il m'aider ?

Merci.
 

martial58

XLDnaute Junior
Re : Besoin d'aide sur fonction Evaluate - Suivi SPC

J'essaie d'utiliser la fonction "EVALUATE' pour calculer la moyenne de la colonne B, suivant la valeur des cellules en A.

Je me contente pour l'instant d'essayer d'afficher le résultat dans une fenêtre.

Ca ne fonctionne pas ...

Critere = ThisWorkbook.Sheets("PRESSAGE").Range("A14:A30")
Valeur = ThisWorkbook.Sheets("PRESSAGE").Range("B14:B30")

x = Evaluate("Average(If(Critere>1,Valeur))")

MsgBox (x)
 

martial58

XLDnaute Junior
Re : Besoin d'aide - Suivi SPC

J'ai testé cette méthode pour calculer la moyenne d'une plage avec FormulaR1C1, mais ça ne me renvoie aucun résultat.
Est-ce que quelqu'un peut regarder ma macro ?
Merci.

Sub Importdonnées()

Dim Masource As Range
Dim Mesvaleurs As Range
Application.ScreenUpdating = False

NbLig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Nbcol = Range("A1").SpecialCells(xlCellTypeLastCell).Column - 2

chemin = "C:\Suivi SPC"
lig = 2
fich = Dir(chemin & "\*.tra")
nom:
ThisWorkbook.Sheets("PRESSAGE").Cells(lig, 1) = fich
fich = Dir
If fich <> "" Then
lig = lig + 1
GoTo nom
End If

For num = 2 To lig
Workbooks.Open chemin & "\" & ThisWorkbook.Sheets("PRESSAGE").Cells(num, 1)
Set Masource = Range("A1:A500")
Masource.Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1))

For num2 = 2 To 11
ThisWorkbook.Sheets("PRESSAGE").Cells(num, num2 + 1) = ActiveSheet.Cells(num2, 2)
Next num2

Range("C14").FormulaR1C1 = "=average(LC(-1):L(26)C(-1))" = Range("C15")
ThisWorkbook.Sheets("PRESSAGE").Cells(num, 13) = Cells(15, 3)

ActiveWorkbook.Close SaveChanges:=False

Next num
Application.ScreenUpdating = True
End Sub