- 帖子
- 33
- 主題
- 4
- 精華
- 0
- 積分
- 37
- 點名
- 0
- 作業系統
- w7
- 軟體版本
- pro
- 閱讀權限
- 10
- 性別
- 女
- 來自
- 台中
- 註冊時間
- 2012-6-20
- 最後登錄
- 2019-5-24
|
7#
發表於 2012-6-30 12:22
| 只看該作者
[code][/code]回復 5# GBKEE
對不起要上傳檔案時出現: 不支持上傳此類擴展名的附件, 只好附上程式
Option Explicit
Sub 執行分析結果()
Dim oi As Integer '設outline計數器
Dim oj As Integer '計算"NG"的家數
Dim ei As Integer ' 找E178值的計數器
Dim wr, xlRow As Integer '設定COPY工作表數目計數器
Dim an As Integer 'outline 分析次數 .並顯示在標題列(b4)
'設定每一個工作表每一有公式的儲存格,順序從(第1 個元素)開始
an = 1 ' 開始outline 分析次數 .
For wr = 4 To Worksheets.Count
With Worksheets(wr)
xlRow = .Range("B" & .Rows.Count).End(xlUp).Row
'"A3"儲存格 NO.OF.RESULT值
.Range("A3").Formula = "=COUNT(B6:B" & xlRow & ")"
'"B3"儲存格分析值中間值(MEDIAN)
.Range("B3").Formula = "=MEDIAN(B6:B" & xlRow & ")"
'C3儲存格IRQ植
.Range("C3").Formula = "=(QUARTILE(B6:B" & xlRow & ",3) -QUARTILE(B6:B" & xlRow & ",1))*0.7413"
'"E3"儲存格ROBUS CV值
.Range("E3").Formula = "= C3 / B3 *100"
'定義"j3"儲存格為分析值平均值
.Range("J3").Formula = "=AVERAGE(B6:B" & xlRow & ")"
'"F3"儲存格分析值中最少值
.Range("F3").Formula = "=MIN(B6:B" & xlRow & ")"
'"G3"儲存格分析值中最大值
.Range("G3").Formula = "=MAX(B6:B" & xlRow & ")"
'"H3"儲存格RANGE值
.Range("H3").Formula = "=G3-F3"
'定義"k3"儲存格為stdv
.Range("k3").Formula = "=STDEV(B6:B" & xlRow & ")"
.Range("B4").Value = an
'"C"欄 Z-SCORE 值
.Range("C6:C" & xlRow & "").Formula = "=(B6-$B$3)/$C$3"
' "D"欄OUTLINE值
.Range("D6:D" & xlRow & "").Formula = "=(B6- $J$3)/$K$3"
.Range("I3").Value = E178(.Range("A3").Value)
End With
'Worksheets(wr).Range("I3")定義E178值在I3儲存格
'For ei = 1 To 102
'If Worksheets(2).Cells(ei, 1).Value = Worksheets(wr).Range("A3").Value Then
'Worksheets(wr).Range("I3").Value = Worksheets(2).Cells(ei, 2).Value
'Exit For
'End If
'Next ei
'"E'欄判別OUTLINE,true="ok"FALSE="NG"
Worksheets(wr).Range("L3").Value = 0 '"NG"家數起始值
For oi = 6 To Worksheets(wr).Range("A3").Value + 5 '開始判別從第6列開始
'比對D6是否< E178值(I3)欄
If Worksheets(wr).Range("D" & oi).Value < Worksheets(wr).Range("I3").Value Then
'值=TRUE時E欄記錄""OK"
Worksheets(wr).Range("E" & oi).Value = "OK"
Else
With Worksheets(wr)
'值= FLACE時E欄記錄"NG"
.Range("E" & oi).Value = "NG"
'設"NG"FONT.COLOR為紅色
.Range("E" & oi).Font.Color = vbRed
'"NG"家數+1
.Range("L3").Value = .Range("L3").Value + 1
End With
End If
Next oi
Next wr
End Sub
Public Function E178(TN As Integer) As Double
Dim ei As Integer
ei = 1
For ei = 1 To TN
If Worksheets(2).Cells(ei, 1).Value = TN Then
E178 = Worksheets(2).Cells(ei, 2).Value
End If
Next ei
End Function |
|
發表於 2012-6-30 13:23
| 
