Calcul capabilité

Bonjour,

Je souhaite calculer la capabilité d'une machine sur différents produits. Pour cela je dispose d'un tableau de mesure(feuille(1)). Pour calculer la capabilité sur les différentes mesures j'ai besoin de la moyenne, de l'écart type et des tolérances min et max. J'ai réussi a trouver le valeurs pour le diamètre(feuill3) mais la méthode que j'ai utilisé me bloque pour poursuivre sur les mesures suivantes notamment à cause du calcul de l'écart type. Auriez-vous une idée d'une autre manière de procéder ?

L'idéal serait d'avoir seulement la colonne capa pour chaque mesure.

Merci d'avance pour votre temps.

Sub calcul()
    Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet
    Dim i As Long, c As Long, REF_DIAM_n As Long, REF_DIAM_m As Single, REF_DIAM_x As Long
    Set f1 = Sheets(Sheets(1).Name)
    Set f2 = Sheets(Sheets(2).Name)
    Set f3 = Sheets(Sheets(3).Name)

    For i = 5 To 32
        derniereligne = f1.Cells(Rows.Count, 1).End(xlUp).Row
        REF_DIAM_n = 0
        REF_DIAM_m = 0
        REF_DIAM_x = 0
        For c = 1 To derniereligne
            If f1.Cells(c, 80) = f2.Cells(i, 3) And f1.Cells(c, 34) = 0 Then
                REF_DIAM_x = REF_DIAM_x + 1
                REF_DIAM_n = REF_DIAM_n + 1
                REF_DIAM_m = REF_DIAM_m + f1.Cells(c, 31)
                f3.Cells(REF_DIAM_x, i) = f1.Cells(c, 31)
            End If
        Next

        With f2
            .Cells(i, 4) = REF_DIAM_n
            .Cells(i, 5) = REF_DIAM_m / REF_DIAM_n
            .Cells(i, 6) = Application.StDev(Range(f3.Cells(1, i), f3.Cells(REF_DIAM_x, i)))
            REF_DIAM_string = f2.Cells(i, 3).Value
            REF_DIAM_TOLMIN = Right(REF_DIAM_string, 2) - 1
            REF_DIAM_TOLMAX = Right(REF_DIAM_string, 2) + 2
            REF_DIAM_v1 = (f2.Cells(i, 5) - REF_DIAM_TOLMIN) / (3 * f2.Cells(i, 6))
            REF_DIAM_v2 = (REF_DIAM_TOLMAX - f2.Cells(i, 5)) / (3 * f2.Cells(i, 6))
            If REF_DIAM_v1 > REF_DIAM_v2 Then
                .Cells(i, 7) = REF_DIAM_v2
            Else
                .Cells(i, 7) = REF_DIAM_v1
            End If
        End With
    Next
    Set f1 = Nothing
    Set f2 = Nothing
    Set f3 = Nothing
End Sub

Bonjour,

Pas sûr de pouvoir vous aider, mais en faisant tourner votre code, je vois qu'il plante ici:

            .Cells(i, 5) = REF_DIAM_m / REF_DIAM_n

parce que 1 des 2 références ou les 2 sont à 0, ce qui génère une erreur, pour contourner cela:

Sub calcul()
    Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet
    Dim i As Long, c As Long, REF_DIAM_n As Long, REF_DIAM_m As Single, REF_DIAM_x As Long
    Set f1 = Sheets(Sheets(1).Name)
    Set f2 = Sheets(Sheets(2).Name)
    Set f3 = Sheets(Sheets(3).Name)

    For i = 5 To 32
        derniereligne = f1.Cells(Rows.Count, 1).End(xlUp).Row
        REF_DIAM_n = 0
        REF_DIAM_m = 0
        REF_DIAM_x = 0
        For c = 1 To derniereligne
            If f1.Cells(c, 80) = f2.Cells(i, 3) And f1.Cells(c, 34) = 0 Then
                REF_DIAM_x = REF_DIAM_x + 1
                REF_DIAM_n = REF_DIAM_n + 1
                REF_DIAM_m = REF_DIAM_m + f1.Cells(c, 31)
                f3.Cells(REF_DIAM_x, i) = f1.Cells(c, 31)
            End If
        Next

        With f2
            On Error Resume Next
            .Cells(i, 4) = REF_DIAM_n
            .Cells(i, 5) = REF_DIAM_m / REF_DIAM_n
            If Err.Number = 0 Then
                .Cells(i, 6) = Application.StDev(Range(f3.Cells(1, i), f3.Cells(REF_DIAM_x, i)))
                REF_DIAM_string = f2.Cells(i, 3).Value
                REF_DIAM_TOLMIN = Right(REF_DIAM_string, 2) - 1
                REF_DIAM_TOLMAX = Right(REF_DIAM_string, 2) + 2
                REF_DIAM_v1 = (f2.Cells(i, 5) - REF_DIAM_TOLMIN) / (3 * f2.Cells(i, 6))
                REF_DIAM_v2 = (REF_DIAM_TOLMAX - f2.Cells(i, 5)) / (3 * f2.Cells(i, 6))
                If REF_DIAM_v1 > REF_DIAM_v2 Then
                    .Cells(i, 7) = REF_DIAM_v2
                Else
                    .Cells(i, 7) = REF_DIAM_v1
                End If
            End If
            On Error GoTo 0
        End With
Suite:
    Next
    Set f1 = Nothing
    Set f2 = Nothing
    Set f3 = Nothing
End Sub

mais je ne suis pas sûr de bien répondre à votre problème.

Cdlt

Bonjour tout le monde,
Normal qu'il plante, à partir de la ligne 17 de la Feuil3, on a 16 produits qui n'existent pas dans la colonne CB (80) de la feuille des mesures. Ce qui conduit à une division par 0 sur la ligne de code :

.Cells(i, 5) = REF_DIAM_m / REF_DIAM_n

Il faut faire un test sur l'existence de mesures pour chaque produit.