返回列表 上一主題 發帖

[發問] 連續N筆資料判別

本帖最後由 n7822123 於 2020-12-31 19:58 編輯

回復 1# y54161212



用 1 與 -1 程式會簡單點,1個迴圈即可搞定

以下 紅色程式 部分,只是列出判斷過程,可有可無

不影響跳品質異常提醒



Sub 判斷品質異常()
Const N = 7   '設定連續次數
Dim Rn&, R%, S%, T%, CL!
Dim 連續大 As Boolean, 連續小 As Boolean
Rn = Cells(Rows.Count, 1).End(xlUp).Row - 2
If Rn < 1 Then Exit Sub
CL = [C1]
With [A3].Resize(Rn, 5)
  Arr = .Value
  .ClearContents
End With
For R = 1 To Rn
  Arr(R, 3) = IIf(Arr(R, 1) > CL, 1, -1)
  S = S + Arr(R, 3)
  If S = N Then 連續大 = True: S = S - 1: Arr(R, 4) = 1
  If S = -N Then 連續小 = True: S = S + 1: Arr(R, 5) = 1
  If Arr(R, 3) <> T Then T = Arr(R, 3): S = T
Next R
[A3].Resize(Rn, 5) = Arr
If 連續大 Then MsgBox "連續7點在中心線同側(大於)"
If 連續小 Then MsgBox "連續7點在中心線同側(小於)"
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2021-1-1 14:20 編輯

回復 4# y54161212

上面兩位真的是太神了
我完全沒辦法吸收(笑

我覺得我寫的很直覺阿,就判斷成1 , -1 在加總而已

ikboy 的正規表示法 我也不是很懂XD

你也可以參考準大的,他是用兩個變數分別加總 

N(1)紀錄大於CL次數
N(0)紀錄小於CL次數



j我的程式,如果要擴展到8次、9次,改N值即可

秀出的訊息沒改到,修改如下


Sub 判斷品質異常()
Const N = 7   '設定連續次數
Dim Rn&, R%, S%, T%, CL!
Dim 連續大 As Boolean, 連續小 As Boolean
Rn = Cells(Rows.Count, 1).End(xlUp).Row - 2
If Rn < 1 Then Exit Sub
CL = [C1]
With [A3].Resize(Rn, 5)
  Arr = .Value
  .ClearContents
End With
For R = 1 To Rn
  Arr(R, 3) = IIf(Arr(R, 1) > CL, 1, -1)
  S = S + Arr(R, 3)
  If S = N Then 連續大 = True: S = S - 1: Arr(R, 4) = 1
  If S = -N Then 連續小 = True: S = S + 1: Arr(R, 5) = 1
  If Arr(R, 3) <> T Then T = Arr(R, 3): S = T
Next R
[A3].Resize(Rn, 5) = Arr
If 連續大 Then MsgBox "連續" & N & "點在中心線同側(大於)"
If 連續小 Then MsgBox "連續" & N & "點在中心線同側(小於)"
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2021-1-1 16:44 編輯

回復 9# 准提部林

感謝準大糾正XD

其實我已發現問題了,只是懶的改~

想說讀資料與寫資料都用同一個陣列解決就好

但是會把前一次的判斷值也寫入Arr (會保留前一次判斷過程)

既然準大糾正了,那我還是拆成2個陣列好了~

另外,祝 準大 新年快樂 ^.^


Sub 判斷品質異常()
Const N = 8   '設定連續次數
Dim Rn&, R%, S%, T%, CL!, Arr, Brr
Dim 連續大 As Boolean, 連續小 As Boolean
Rn = Cells(Rows.Count, 1).End(xlUp).Row - 2
If Rn < 1 Then Exit Sub
CL = [C1]
Arr = [A3].Resize(Rn)
[C3].Resize(Rn, 3).ClearContents
ReDim Brr(1 To Rn, 1 To 3)

For R = 1 To Rn
  Brr(R, 1) = IIf(Arr(R, 1) > CL, 1, -1)
  S = S + Brr(R, 1)
  If S = N Then 連續大 = True: S = S - 1: Brr(R, 2) = 1
  If S = -N Then 連續小 = True: S = S + 1: Brr(R, 3) = 1
  If Brr(R, 1) <> T Then T = Brr(R, 1): S = T
Next R
[C3].Resize(Rn, 3) = Brr
If 連續大 Then MsgBox "連續" & N & "點在中心線同側(大於)"
If 連續小 Then MsgBox "連續" & N & "點在中心線同側(小於)"
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 手心向下是助人,手心向上是求人;助人快樂,求人痛苦。
返回列表 上一主題