標題: [發問] 判斷資料是否呈獻趨勢 [打印本頁]

---

作者: smooth131    時間: 2011-8-25 00:10     標題: 判斷資料是否呈獻趨勢

本帖最後由 smooth131 於 2011-8-25 00:12 編輯

程式目的】
檢查資料欄位，若是資料連續（當>num時）遞增or遞減，就出現「一次」msgbox

【問題描述】
(1) 在選定的資料欄中，只要其中有七組數據（可能是在群組的任何一個區段）是有增加or減少的現像就會出現msgbox
     想了很久還是不知道怎麼才能讓它判斷"連續"
(2) msgbox出現的次數不止一次

【程式碼】
Sub WrongTrend()

Dim RowNum As Integer, num As Integer
num = 7
ActiveSheet.Select
Range(Cells.Find("X-bar").Offset(1, 0), Cells.Find("X-bar").Offset(1, 0).End(xlDown)).Select
RowNum = Selection.CountLarge

For i = 1 To (RowNum - 1)
    If Cells(i, 1).Value < Cells(i + 1, 1).Value Then
        k = k + 1
        'Sheets("sheet2").Cells(i, 1).Value = k
        If k > num Then
            MsgBox "樣本呈遞增現象", , "製程異常"
            k = 0
        End If
    ElseIf Cells(i, 1).Value > Cells(i + 1, 1).Value Then
        k = k + 1
        'Sheets("sheet2").Cells(i, 1).Value = k
        If k > num Then
            MsgBox "樣本呈遞減現象", , "製程異常"
            k = 0
        End If
    Else
        k = 0
    End If
Next

End Sub
[attach]7572[/attach]
感謝您耐心的閱讀    m(-_-)m

---

作者: kimbal    時間: 2011-8-25 00:32

就是有任何MSGBOX出現就停止檢查?
最簡單的話可以在MSGBOX後加上EXIT SUB

'目前是num總數>7，而非連續7個num
Sub WrongTrend()

Dim RowNum As Integer, num As Integer
num = 7
ActiveSheet.Select
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Select
RowNum = Selection.CountLarge

For i = 1 To (RowNum - 1)
    If Cells(i, 1).Value < Cells(i + 1, 1).Value Then
        k = k + 1
        'Sheets("sheet2").Cells(i, 1).Value = k
        If k > num Then
            MsgBox "樣本呈遞增現象", , "製程異常"
            k = 0
            Exit Sub
        End If
    ElseIf Cells(i, 1).Value > Cells(i + 1, 1).Value Then
        k = k + 1
        'Sheets("sheet2").Cells(i, 1).Value = k
        If k > num Then
            MsgBox "樣本呈遞減現象", , "製程異常"
            k = 0
            Exit Sub
        End If
    Else
        k = 0
    End If
Next

---

作者: smooth131    時間: 2011-8-25 22:19

真得耶~~~~~是我想得太複雜的，結果愈寫愈複雜
感謝您的提醒  m(-_-)m

---

作者: smooth131    時間: 2011-8-25 23:09

依循這個主題再問一次，那如果程式改成這樣（請參照附件檔中的Sub WrongTrend）[attach]7581[/attach]

為什麼明明沒有遞減現象，卻會一直出現遞減的msgbox

感謝您的回答

程式碼如下所示，新手請多包涵  m(-_-)m

1. Sub WrongTrend()
   
2. 
   
3. Dim RowNum As Integer, num As Integer
   
4. num = 7
   
5. Sheets("Xbar-R").Select
   
6. Range(Cells.Find("X-bar").Offset(1, 0), Cells.Find("X-bar").Offset(1, 0).End(xlDown)).Select
   
7. RowNum = Selection.CountLarge
   
8. 
   
9. For i = 1 To (RowNum - 1)
   
10.     If Cells(i + 3, 7).Value < Cells(i + 4, 7).Value Then
    
11.         k = k + 1
    
12.         If k > num Then
    
13.             MsgBox "樣本呈遞增現象", , "製程異常"
    
14.             k = 0
    
15.             Exit Sub
    
16.         End If
    
17.     ElseIf Cells(i + 3, 7).Value > Cells(i + 4, 7).Value Then
    
18.         k = k + 1
    
19.         If k > num Then
    
20.             MsgBox "樣本呈遞減現象", , "製程異常"
    
21.             k = 0
    
22.             Exit Sub
    
23.         End If
    
24.     Else
    
25.         k = 0
    
26.     End If
    
27. Next
    
28. 
    
29. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)