台灣最大程式設計社群網站
線上人數
1739
 
會員總數:241182
討論主題:186829
歡迎您免費加入會員
討論區列表 >> office VBA / WinOS >> 比對某分頁數值匯出前比對上下限
[ 變換順序 ]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
比對某分頁數值匯出前比對上下限
價值 : 50 QP  點閱數:224 回應數:0

樓主

阿男
門外漢
0 1
6 0
發送站內信

想新增比對某欄位( 預傾角 cellgap 扭轉角)數值的上下限超規會提示

https://pan.baidu.com/s/1i55ikkd

我有三個補登格式分頁要比對我設定好的上下限出現超規會提示要如何新增
每個機種都可以個別設定上下限

Sub APA(gg As Workbook) ' 開始轉換程序
Dim i As Integer, MyNum As Integer, MySum As Double, MySigma As Double, MyAverage As Double, MyMax As Double, MyMin As Double, k As Integer, mm As Integer
Dim test As Double, n As Integer
gg.Activate

With gg.Worksheets(1)
If .Range("A5") = "TFT材質" Then ' 該檔案為 Cell Gap
i = 9
ElseIf .Range("A7") = "Point_1" Then ' 該檔案為預傾角
i = 6
Else
i = 9
End If
j = 2
While .Cells(i, j) <> ""
MyNum = Application.WorksheetFunction.CountA(.Range("A:A").Offset(0, j - 1)) - i + 1
n = MyNum + i - 1
MySum = Application.WorksheetFunction.Sum(.Range(.Cells(i, j), .Cells(n, j)))
MyAverage = Application.WorksheetFunction.Average(.Range(.Cells(i, j), .Cells(n, j)))
MySigma = Application.WorksheetFunction.StDevP(.Range(.Cells(i, j), .Cells(n, j)))
MyMax = Application.WorksheetFunction.Max(.Range(.Cells(i, j), .Cells(n, j)))
MyMin = Application.WorksheetFunction.Min(.Range(.Cells(i, j), .Cells(n, j)))
k = i
mm = 0
While k <= n
test = Abs(.Cells(k, j) - MyAverage)
If test > 3 * MySigma Then
.Cells(k, j).Font.ColorIndex = 3
UserForm2.Caption = "第 " + Str(j - 1) + " 筆,第 " + Str(k - i + 1) + " 點離異"
UserForm2.Label5 = "最大值:" + Format(MyMax, "0.000")
UserForm2.Label6 = "最小值:" + Format(MyMin, "0.000")
UserForm2.Label1 = "平均值:" + Format(MyAverage, "0.000")
UserForm2.Label2 = "3 倍標準差:" + Format(MySigma * 3, "0.000") + "(" + Format(MyAverage - MySigma * 3, "0.000") + " ~ " + Format(MyAverage + MySigma * 3, "0.000") + ")"
UserForm2.Label3 = "離異值:" + Format(.Cells(k, j), "0.000")
If k > i And k < MyNum + i - 1 Then
UserForm2.TextBox1 = Format((.Cells(k - 1, j) + .Cells(k + 1, j)) / 2, "0.000")
ElseIf k = i Then
UserForm2.TextBox1 = Format((.Cells(k + 1, j) + .Cells(k + 2, j)) / 2, "0.000")
ElseIf k = MyNum + i - 1 Then
UserForm2.TextBox1 = Format((.Cells(k - 1, j) + .Cells(k - 2, j)) / 2, "0.000")
Else
End If
UserForm2.Show
If UserForm2.TextBox1 <> "" Then
.Cells(k, j) = Format(UserForm2.TextBox1, "0.000")
mm = mm + 1
End If
End If
k = k + 1
Wend
If mm > 5 Then
MsgBox "修正了 " + Str(mm) + " 筆數據" + vbCrLf + "修正的點數太多了,應該通知工程師確認!", vbOKOnly, "請注意!"
ElseIf mm > 0 Then
MsgBox "修正了 " + Str(mm) + " 筆數據", vbOKOnly, "請注意!"
End If
If .Range("A5") = "TFT材質" And 3 * MySigma >= 0.2 Then
MsgBox "第" + Str(j - 1) + "筆的 Cell Gap 量測結果太糟糕了,數據跳動很大" + vbCrLf + "請通知工程師確認數據!", vbOKOnly, "請注意!"
ElseIf i = 6 And 3 * MySigma >= 0.9 Then
MsgBox "第" + Str(j - 1) + "筆的 預傾角 量測結果太糟糕了,數據跳動很大" + vbCrLf + "請通知工程師確認數據!", vbOKOnly, "請注意!"
ElseIf .Range("A5") = "TFT 配向枚數" And 3 * MySigma >= 1 Then
MsgBox "第" + Str(j - 1) + "筆的 扭轉角 量測結果太糟糕了,數據跳動很大" + vbCrLf + "請通知工程師確認數據!", vbOKOnly, "請注意!"
ElseIf .Range("A5") = "TFT 配向枚數" And 3 * MySigma >= 1 Then
End If
j = j + 1
Wend
End With
End Sub






搜尋相關Tags的文章: [ 比對 ] ,
本篇文章發表於2017-06-06 02:14
別忘捐VP感謝幫助你的人 新手會員瞧一瞧
目前尚無任何回覆
[ 變換順序 ]   

回覆
如要回應,請先登入.