急求答案，在SPC管制图中，如何用宏（VBA）自动判定SPC管制图中的点？急求详细VBA代码，有加

Question

急求答案，在SPC管制图中，如何用宏（VBA）自动判定SPC管制图中的点？急求详细VBA代码，有加分噢！

Answer 1

Option Base 1
Sub aa()
'将非连续数据变为连续
Dim arr() As Variant, rrr() As Variant, crr() As Variant

n = 0
For Each Rng In Range("b27:Af27,b30:Af30") '因表格不同需修改！！！！！
    If Rng <> "" Then
        n = n + 1
        ReDim Preserve arr(n)
        ReDim Preserve rrr(n)
        ReDim Preserve crr(n)
        arr(n) = Rng.Value
        rrr(n) = Rng.Row
        crr(n) = Rng.Column
    End If
Next

'引入控制图均值与极差(因表格不同需修改！！！！！！！！！！！）
Xbar = Range("j7")
R = Range("j16")
AE2 = 2.659
D4 = 3.267

UCL = Xbar + AE2 * R
LCL = Xbar - AE2 * R
UCLR = D4 * R

UL1 = Xbar + AE2 * R / 3
LL1 = Xbar - AE2 * R / 3
UL2 = Xbar + AE2 * R / 3 * 2
LL2 = Xbar - AE2 * R / 3 * 2


'Test 1: 1 point more than 3s from center line
For i = 1 To n
    If arr(i) >= UCL Or arr(i) <= LCL Then
        Cells(rrr(i), crr(i)).Font.Color = -16776961
    End If
Next

'Test 2: 9 points in a row on same side of center line
a = 0
b = 0
For i = 1 To n
    If arr(i) < Xbar Then
        a = i
    ElseIf arr(i) > Xbar Then
        b = i
    Else
        a = i
        b = i
    End If
    
    s = a - b
    If s > 8 Or s < -8 Then
        For k = i - 8 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

'Test 3: 6 points in a row, all increasing or all decreasing
a = 1
b = 1
For i = 2 To n
    If arr(i) > arr(i - 1) Then
        a = i
    ElseIf arr(i) < arr(i - 1) Then
        b = i
    Else
        a = i
        b = i
    End If
    
    s = a - b
    If s > 5 Or s < -5 Then
        For k = i - 5 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

 'Test 4: 14 points in a row, alternating up and down
a = 1
b = 1
p = 1
For i = 2 To n
    If arr(i) * p > arr(i - 1) * p Then
        a = i
    ElseIf arr(i) * p < arr(i - 1) * p Then
        b = i
    Else
        a = i
        b = i
    End If
        
    p = -p
    s = a - b
    If s > 13 Or s < -13 Then
        For k = i - 13 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

'Test 5:  2 out of 3 points > 2s from center line (same side)

For i = 3 To n
    a = 0
    b = 0
    For j = 0 To 2
        If arr(i - j) >= UL2 Then
            a = a + 1
        ElseIf arr(i - j) <= LL2 Then
            b = b + 1
        End If
    Next
    
    If a > 1 Or b > 1 Then
        For k = i - 2 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

 'Test 6: 4 out of 5 points > 1s from center line (same side)

For i = 5 To n
    a = 0
    b = 0
    For j = 0 To 4
        If arr(i - j) >= UL1 Then
            a = a + 1
        ElseIf arr(i - j) <= LL1 Then
            b = b + 1
        End If
    Next
    
    If a > 3 Or b > 3 Then
        For k = i - 4 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

  'Test 7: 15 points in a row within 1s of center line (either side)
For i = 15 To n
    a = 0
    For j = 0 To 14
        If arr(i - j) >= LL1 And arr(i - j) <= UL1 Then
            a = a + 1
        End If
    Next
    
    If a > 14 Then
        For k = i - 14 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

'Test 8: 8 points in a row > 1s from center line (either side)
For i = 8 To n
    a = 0
    For j = 0 To 7
        If arr(i - j) >= UL1 Or arr(i - j) <= LL1 Then
            a = a + 1
        End If
    Next
    
    If a > 7 Then
        For k = i - 7 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

'Test 9:1 point over uclr
For i = 2 To n
    If Abs(arr(i) - arr(i - 1)) >= UCLR Then
        For k = i - 1 To i
            Cells(rrr(k), crr(k)).Font.Color = -16776961
        Next
    End If
Next

End Sub

Answer 2

SPC管制图有八个判异准则，举个例子，供参考吧……
' 9 points in a row on same side of center line
center=中心线
For i = 8 To a
iUCount = 0
iLCount = 0
For b = 0 To 8
If Cells(2 + i - b, 1) > center then
iUCount = iUCount + 1
ElseIf Cells(2 + i - b, 1) <center then
iLCount = iLCount + 1
End If
Next b
If iUCount >= 9 Or iLCount >= 9 Then
msgbox “9 points in a row on same side of center line ”
End If
Next i本回答被网友采纳

Answer 3

哎，苦逼的质量人。追问

什么意思？

追答

不知道你做的SPC管制图是散点图还是折线图。
无论是哪一种，点子的数据总是存在于工作表中。
这样的话，判断是否超限，可以直接在工作表中判断大小即可。