帖子: 31
主題: 7
精華: 0
積分: 70
點名: 0
作業系統: Windows10
軟體版本: Office365
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2020-6-14
最後登錄: 2024-8-19

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2020-12-31 14:38 | 只看該作者

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

我想寫一個判斷品質的程式
大概內容為將數值與中心值CL判斷
在C欄
> CL =1
<CL =0
用此C欄判斷
然後在
D欄位標註是否連續7筆資料都是>CL
E欄位判斷是否連續7筆都是都是<CL

=========================程式碼==================
Dim side%, QQ%, QQ1%, CL As Variant
k = Cells(Rows.Count, 1).End(xlUp).Row
CL = Range("C1").Value
Range("C3:E" & k).ClearContents

If CL <> "" And k - 1 > 0 Then
For i = 3 To k

   If Range("A" & i) > CL Then
   Range("C" & i) = 1
   Else
   Range("C" & i) = 0
   End If

Next
End If
'==判斷是否連續7筆大於或小於CL========
For i = 3 To k
      If (Range("C" & i) = 1 And Range("C" & i + 1) = 1 And Range("C" & i + 2) = 1 And Range("C" & i + 3) = 1 And Range("C" & i + 4) = 1 And Range("C" & i + 5) = 1 And Range("C" & i + 6) = 1) Then
      Range("D" & i + 6) = 1

      ElseIf (Range("C" & i) = 0 And Range("C" & i + 1) = 0 And Range("C" & i + 2) = 0 And Range("C" & i + 3) = 0 And Range("C" & i + 4) = 0 And Range("C" & i + 5) = 0 And Range("C" & i + 6) = 0) Then
      Range("E" & i + 6) = 1
End If
Next

QQ = Application.WorksheetFunction.Sum(Range("D3:D" & k))
QQ1 = Application.WorksheetFunction.Sum(Range("E3:E" & k))

If QQ >= 1 Then
MsgBox "連續7點在中心線同側(大於)"
End If

If QQ1 >= 1 Then
MsgBox "連續7點在中心線同側(小於)"
End If

================================================================
我在想是否有更好的寫法用來判斷
連續7筆資料>CL或<CL

請求指導
謝謝各位先進

Q test.zip (21.42 KB)

樓主熱帖

莫讓他人錯誤傷害自己

y54161212

中學生 Rank: 2

帖子: 31
主題: 7
精華: 0
積分: 70
點名: 0
作業系統: Windows10
軟體版本: Office365
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2020-6-14
最後登錄: 2024-8-19

論壇榮譽勳章論壇贊助勳章

14^#

發表於 2021-1-7 10:22 | 只看該作者

這種比較簡單的概念我就代勞一下:
程式開頭就定義了 T% 表示它是個整數,
一開始沒特別去賦值時預設值是 ...
luhpro 發表於 2021-1-6 23:32

  Brr(R, 1) = IIf(Arr(R, 1) > CL, 1, -1)
  S = S + Brr(R, 1) : MsgBox S
'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) : MsgBox T: S = T  :MsgBox S

昨天用這種方式
終於搞懂了最後一行的意義....

謝謝您的協助編寫註解

莫讓他人錯誤傷害自己

TOP

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

13^#

發表於 2021-1-6 23:32 | 只看該作者

本帖最後由 luhpro 於 2021-1-6 23:57 編輯

If Brr(R, 1) T Then T = Brr(R, 1): S = T
If Brr(R, 1) <> T Then T = Brr(R, 1): S = T
這一行我讀不懂
測試如果把它移除，就不會出現"連續小" 的標記跟訊息
Brr(R, 1) <> T ( T是從何而來?
y54161212 發表於 2021-1-6 14:43

這種比較簡單的概念我就代勞一下:
程式開頭就定義了 T% 表示它是個整數,
一開始沒特別去賦值時預設值是0,
也就是說第1次是跟0比較.

  Brr(R, 1) = IIf(Arr(R, 1) > CL, 1, -1) ' 比較後指定加減數
  S = S + Brr(R, 1) ' 大於時 + 1, 小於時 - 1, 加到 +8 或 -8 時就是連續8次大於或小於了
  If S = N Then 連續大 = True: S = S - 1: Brr(R, 2) = 1  ' 這裡是 "大於" 區 S=8後 S=S-1 就變回 7, 下次再加1就又=8 可再次觸發本行的條件
  If S = -N Then 連續小 = True: S = S + 1: Brr(R, 3) = 1 ' "小於" 區, 原理同上.
  If Brr(R, 1) <> T Then T = Brr(R, 1): S = T  ' 其實就是保存本次的值以備下一次比較是不是值不同了用.

這裡順便也提供一下我當時修改後的解法, (以3#做母版修改)
嘗試改成顯示 0 而不是 -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 [C3].Resize(Rn, 3)
Arr = .Offset(, -2).Resize(, 5).Value
.ClearContents
End With
For R = 1 To Rn
Arr(R, 3) = IIf(Arr(R, 1) > CL, 1, 0)
S = S + (Arr(R, 3) = 0) * 2 + 1
If S = N Then S = S - 1: 連續大 = True: Arr(R, 4) = 1
If S = -N Then S = S + 1: 連續小 = True: 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

y54161212

中學生 Rank: 2

帖子: 31
主題: 7
精華: 0
積分: 70
點名: 0
作業系統: Windows10
軟體版本: Office365
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2020-6-14
最後登錄: 2024-8-19

論壇榮譽勳章論壇贊助勳章

12^#

發表於 2021-1-6 14:43 | 只看該作者

回復准提部林

感謝準大糾正XD

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

想說讀資料與寫資料都用同一個 ...
n7822123 發表於 2021-1-1 16:33

If Brr(R, 1) <> T Then T = Brr(R, 1): S = T
這一行我讀不懂
測試如果把它移除，就不會出現"連續小" 的標記跟訊息
Brr(R, 1) <> T ( T是從何而來?

莫讓他人錯誤傷害自己

TOP

y54161212

中學生 Rank: 2

帖子: 31
主題: 7
精華: 0
積分: 70
點名: 0
作業系統: Windows10
軟體版本: Office365
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2020-6-14
最後登錄: 2024-8-19

論壇榮譽勳章論壇贊助勳章

11^#

發表於 2021-1-6 11:56 | 只看該作者

其實有些寫法我真的看不懂
但我都用測試的方式來理解各位的語言
VBA真是一條不歸路 (誤

莫讓他人錯誤傷害自己

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

10^#

發表於 2021-1-1 16:33 | 只看該作者

本帖最後由 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

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

9^#

發表於 2021-1-1 15:54 | 只看該作者

回復 8# n7822123

With [A3].Resize(Rn, 5)
Arr = .Value '五欄資料存入陣列
.ClearContents '清除原有資料, 但原資料還在陣列中, 當陣列貼回時, 還會有殘留, 可修改a欄參數不更動其它列資料試試
End With

另外, 儘量不要清空原數據, 避免程式因錯誤中斷而遺失資料,
而且, 貼回時, 也應限制在變動區, 而避免全區貼回, 若資料龐大則須花費回寫填滿的時間

===============================

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

8^#

發表於 2021-1-1 14:11 | 只看該作者

本帖最後由 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

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

7^#

發表於 2021-1-1 11:27 | 只看該作者

D3//右拉/下拉
=IF(COUNTIF(OFFSET($A3,,,-MIN(ROW(A1),7)),IF(COLUMN(A1)=1,">","<=")&$C$1)>6,1,"")

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

6^#

發表於 2021-1-1 11:18 | 只看該作者

本帖最後由准提部林於 2021-1-1 11:20 編輯

Sub 判斷品質異常_A()
Dim Arr, Brr, R&, C%, N%(1), X%(1), i&, CL!
R = Cells(Rows.Count, 1).End(xlUp).Row - 2
If R < 1 Then Exit Sub
CL = [C1]
Arr = [A3].Resize(R)
ReDim Brr(1 To R, 1 To 4)
For i = 1 To R
C = -(Arr(i, 1) > CL): Brr(i, 1) = C
N(C) = N(C) + 1: N(1 - C) = 0
If N(C) >= 7 Then Brr(i, 3 - C) = 1: X(C) = 1
Next i
[C3].Resize(R, 4) = Brr
If X(1) Then MsgBox "連續7點在中心線同側(大於)"
If X(0) Then MsgBox "連續7點在中心線同側(小於)"
End Sub

'================================

TOP