[转帖]Excel绘制SPC范例

littlejinyi

哈hA 分享下

gamyer1111

受教了，学习了，很好的分享

lisalcy150

太感谢了，一直想知道。

zoysia

下载研究，需要好好理解一下SPC，目前也遇到这方面的问题了，谢谢斑竹

以网生活

很大的启迪，回去慢慢研究

happle

谢谢了。。。

楼主如果附上一张SPC 图更好。。。

yangyang51555

真羡慕你们  同样是excel  我不会！！！

kuele

提供了一个很好的样本，值得参考，谢谢楼主。

lgcmeli

感谢分享。

OULEE

Option Explicit

Function CheckErrorByRange(ByVal ragTarget As Range, sgUCL As Single, sgLCL As Single) As Single
   
    Dim ragCell As Range
    Dim arSeries() As Single
    Dim i As Integer
    Dim sgTemp As Single
   
    ReDim arSeries(255)
    For Each ragCell In ragTarget
        arSeries(i) = ragCell
        i = i + 1
        If i > 255 Then
            Exit For
        End If
    Next ragCell
   
    ReDim Preserve arSeries(i - 1)
    CheckErrorByRange = GetPatternID(arSeries, sgUCL, sgLCL)
   
End Function

Function ExtractBinByDec(iDec As Integer, iDigit As Integer) As Integer
   
    Dim i As Integer
    Dim iRet As Integer
    For i = 1 To iDigit
        iRet = iDec - 2 * Int(iDec / 2)
        iDec = Int(iDec / 2)
    Next i
    ExtractBinByDec = iRet
   
End Function
Private Function GetPatternID(varSeries As Variant, sgUCL As Single, sgLCL As Single) As Integer
   
    Dim i As Integer
    Dim iLength As Integer
    Dim iExist As Integer
   
    Dim iReturn As Integer
    Dim sgCL As Single
    Dim sgSigma As Single
   
    Dim iUCount As Integer
    Dim iLCount As Integer
   
    sgCL = (sgUCL + sgLCL) / 2
    sgSigma = (sgUCL - sgLCL) / 6
   
    iLength = UBound(varSeries)
   
    'Test 1: 1 point more than 3s from center line
    iExist = 0
    If varSeries(iLength) > sgUCL Or varSeries(iLength) < sgLCL Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 0 * iExist
   
    'Test 2: 9 points in a row on same side of center line
    iUCount = 0
    iLCount = 0
    iExist = 0
    For i = 0 To 8
        If varSeries(iLength - i) > sgCL Then
            iUCount = iUCount + 1
        ElseIf varSeries(iLength - i) < sgCL Then
            iLCount = iLCount + 1
        End If
    Next i
    If iUCount = 9 Or iLCount = 9 Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 1 * iExist
   
    'Test 3: 6 points in a row, all increasing or all decreasing
    iUCount = 0
    iLCount = 0
    iExist = 0
    For i = 0 To 5
        If varSeries(iLength - i) > varSeries(iLength - i - 1) Then
            iUCount = iUCount + 1
        ElseIf varSeries(iLength - i) < varSeries(iLength - i - 1) Then
            iLCount = iLCount + 1
        End If
    Next i
    If iUCount = 6 Or iLCount = 6 Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 2 * iExist
   
    'Test 4: 14 points in a row, alternating up and down
    iUCount = 0
    iLCount = 0
    iExist = 0
    For i = 0 To 10 Step 2
        If varSeries(iLength - i) > varSeries(iLength - i - 1) And varSeries(iLength - i - 1) < varSeries(iLength - i - 2) Then
            iUCount = iUCount + 1
        ElseIf varSeries(iLength - i) < varSeries(iLength - i - 1) And varSeries(iLength - i - 1) > varSeries(iLength - i - 2) Then
            iLCount = iLCount + 1
        End If
    Next i
    If iUCount = 6 Or iLCount = 6 Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 3 * iExist
   
    'Test 5:  2 out of 3 points > 2s from center line (same side)
    iUCount = 0
    iLCount = 0
    iExist = 0
    For i = 0 To 2
        If varSeries(iLength - i) > (sgCL + 2 * sgSigma) Then
            iUCount = iUCount + 1
        ElseIf varSeries(iLength - i) < (sgCL - 2 * sgSigma) Then
            iLCount = iLCount + 1
        End If
    Next i
    If iUCount >= 2 Or iLCount >= 2 Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 4 * iExist

    'Test 6: 4 out of 5 points > 1s from center line (same side)
    iUCount = 0
    iLCount = 0
    iExist = 0
    For i = 0 To 4
        If varSeries(iLength - i) > (sgCL + 1 * sgSigma) Then
            iUCount = iUCount + 1
        ElseIf varSeries(iLength - i) < (sgCL - 1 * sgSigma) Then
            iLCount = iLCount + 1
        End If
    Next i
    If iUCount >= 4 Or iLCount >= 4 Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 5 * iExist
   
    'Test 7: 15 points in a row within 1s of center line (either side)
    iUCount = 0
    iLCount = 0
    iExist = 0
    For i = 0 To 14
        If varSeries(iLength - i) < (sgCL + 1 * sgSigma) And varSeries(iLength - i) >= sgCL Then
            iUCount = iUCount + 1
        ElseIf varSeries(iLength - i) > (sgCL - 1 * sgSigma) And varSeries(iLength - i) <= sgCL Then
            iLCount = iLCount + 1
        End If
    Next i
    If iUCount + iLCount = 15 Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 6 * iExist
   
    'Test 8: 8 points in a row > 1s from center line (either side)
    iUCount = 0
    iLCount = 0
    iExist = 0
    For i = 0 To 7
        If varSeries(iLength - i) > (sgCL + 1 * sgSigma) Then
            iUCount = iUCount + 1
        ElseIf varSeries(iLength - i) < (sgCL - 1 * sgSigma) Then
            iLCount = iLCount + 1
        End If
    Next i
    If iUCount + iLCount = 8 Then
        iExist = 1
    End If
    iReturn = iReturn + 2 ^ 7 * iExist
   
    GetPatternID = iReturn
   
End Function