- 帖子
- 21
- 主題
- 1
- 精華
- 0
- 積分
- 52
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- Office 2010
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2015-3-13
- 最後登錄
- 2023-10-16
|
2#
發表於 2015-4-23 13:06
| 只看該作者
抱歉我剛加入這個論壇沒很久 還是小學生無法下載你的檔案幫你改
以下是我之前寫過一段計算變異數與標準差的程式碼,您可以擷取您要的部分,有問題可以一起討論唷
Public Sub sorter_data()
Dim data(1000, 11, 7), dataa(1000, 4), dataaa(1000, 4), gfilename, myfile, ppath, search, search1, search2, number, stastic, year, mon, day, bn, search3, search4
data(0, 0, 0) = Sheet1.Cells(1, 3)
year = Format(data(0, 0, 0), "yyyy")
mon = Format(data(0, 0, 0), "mm")
day = Format(data(0, 0, 0), "dd")
data(1, 0, 0) = "sorter1"
data(2, 0, 0) = "sorter2"
data(3, 0, 0) = "sorter3"
data(4, 0, 0) = "sorter4"
data(5, 0, 0) = "sorter5"
data(6, 0, 0) = "sorter6"
data(7, 0, 0) = "sorter7"
For k = 1 To 7
Sheets(k).Range("A3:Q1000").ClearContents
Sheets(k).Range("A3:Q1000").Interior.ColorIndex = iro
b = 0
ppath = "M:\QC\檢驗資料\Wafer\Sorter data\" + data(k, 0, 0) + "\" + year + "-" + mon + "-" + day + "\"
myfile = Dir(ppath + "*.csv")
Do While myfile <> ""
If myfile = "" Then Exit Do
bn = 0
b = b
a = 1
If Mid(myfile, 1, 1) = "V" Then
bn = bn + 1
data(bn, 1, 1) = Mid(myfile, 1, 12)
Sheets(k).Cells(b + 3, 1) = Mid(data(bn, 1, 1), 6, 7)
gfilename = ppath + myfile
Open gfilename For Input As #1
Line Input #1, textline
Do While Not EOF(1)
Line Input #1, textline
search = ","
For i = 1 To 7
search1 = search2 + 1
search2 = InStr(search1, textline, search, vbTextCompare)
Select Case i '各筆資料匯入
Case 4: data(a, 2, k) = Val(Mid(textline, search1, search2 - search1)) 'LT
Case 5: data(a, 3, k) = Val(Mid(textline, search1, search2 - search1)) 'TAV
Case 6: data(a, 4, k) = Val(Mid(textline, search1, search2 - search1)) 'TTV
Case 7: data(a, 5, k) = Val(Mid(textline, search1, search2 - search1)) 'RS
' Sheet9.Cells(a, 10) = data(a, 2, k)
' Sheet9.Cells(a, 11) = data(a, 3, k)
' Sheet9.Cells(a, 12) = data(a, 4, k)
' Sheet9.Cells(a, 13) = data(a, 5, k)
End Select
Next
For M = 1 To 10
search3 = search4 + 1
search4 = InStr(search3, textline, ";", vbTextCompare)
If M = 10 And search4 <> 0 Then
data(a, 6, k) = Val(Mid(textline, search3, search4 - search3)) 'warp
' Sheet9.Cells(a, 14) = data(a, 6, k)
End If
Next
search3 = 0
search4 = 0
If textline = "" Then Exit Do
a = a + 1
search1 = 0
search2 = 0
search3 = 0
search4 = 0
If a / 100 = 1 Then
lt = 0
tav = 0
ttv = 0
rs = 0
For p = a - 99 To a
If data(p, 2, k) <= 0.5 Then 'lt極端值去除
data(p, 2, k) = 0
lt = lt + 1
End If
If data(p, 3, k) <= 160 Or data(p, 3, k) >= 240 Then 'tav極端值去除
data(p, 3, k) = 0
tav = tav + 1
End If
If data(p, 4, k) > 60 Then 'ttv極端值去除
data(p, 4, k) = 0
ttv = ttv + 1
End If
If data(p, 5, k) <= 0.5 Or data(p, 5, k) > 4 Then 'rs極端值去除
data(p, 5, k) = 0
rs = rs + 1
End If
Next
End If
If a / 100 = 1 Then '百筆資料平均
b = b + 1
For q = 2 To 11
data(b, q, 0) = 0
Next
'----------------------------------------------------------------------------------------------------------------標準差計算
For j = a - 99 To a
data(b, 2, 0) = data(j, 2, k) + data(b, 2, 0) 'LT加總
data(b, 3, 0) = data(j, 3, k) + data(b, 3, 0) 'TAV加總
data(b, 4, 0) = data(j, 4, k) + data(b, 4, 0) 'TTV加總
data(b, 5, 0) = data(j, 5, k) + data(b, 5, 0) 'RS加總
data(b, 6, 0) = data(j, 6, k) + data(b, 6, 0) 'warp加總
data(b, 7, 0) = data(j, 2, k) ^ 2 + data(b, 7, 0) 'LT各筆資料^2
data(b, 8, 0) = data(j, 3, k) ^ 2 + data(b, 8, 0) 'TAV各筆資料^2
data(b, 9, 0) = data(j, 4, k) ^ 2 + data(b, 9, 0) 'TTV各筆資料^2
data(b, 10, 0) = data(j, 5, k) ^ 2 + data(b, 10, 0) 'RS各筆資料^2
data(b, 11, 0) = data(j, 6, k) ^ 2 + data(b, 11, 0) 'warp各筆資料^2
Next
data(b, 2, 0) = data(b, 2, 0) / (100 - lt) 'LT平均資料
data(b, 3, 0) = data(b, 3, 0) / (100 - tav) 'TAV平均資料
data(b, 4, 0) = data(b, 4, 0) / (100 - ttv) 'TTV平均資料
data(b, 5, 0) = data(b, 5, 0) / (100 - rs) 'RS平均資料
data(b, 6, 0) = data(b, 6, 0) / 100 'warp平均資料
data(b, 7, 0) = Sqr((data(b, 7, 0) - ((100 - lt) * data(b, 2, 0) ^ 2)) / (99 - lt))
data(b, 8, 0) = Sqr((data(b, 8, 0) - ((100 - tav) * data(b, 3, 0) ^ 2)) / (99 - tav))
data(b, 9, 0) = Sqr((data(b, 9, 0) - ((100 - ttv) * data(b, 4, 0) ^ 2)) / (99 - ttv))
data(b, 10, 0) = Sqr((data(b, 10, 0) - ((100 - rs) * data(b, 5, 0) ^ 2)) / (99 - rs))
data(b, 11, 0) = Sqr((data(b, 11, 0) - (100 * (data(b, 6, 0) ^ 2))) / 99)
Sheets(k).Cells(b + 2, 2) = data(b, 2, 0)
Sheets(k).Cells(b + 2, 3) = data(b, 3, 0)
Sheets(k).Cells(b + 2, 4) = data(b, 4, 0)
Sheets(k).Cells(b + 2, 5) = data(b, 5, 0)
Sheets(k).Cells(b + 2, 6) = data(b, 6, 0)
Sheets(k).Cells(b + 2, 7) = data(b, 7, 0)
Sheets(k).Cells(b + 2, 8) = data(b, 8, 0)
Sheets(k).Cells(b + 2, 9) = data(b, 9, 0)
Sheets(k).Cells(b + 2, 10) = data(b, 10, 0)
Sheets(k).Cells(b + 2, 11) = data(b, 11, 0)
a = 1
'--------------------------------------------------------------------------------------------------------------------
End If
Loop
Close #1
End If
myfile = Dir
Loop
Next
gfilename = "M:\QC\檢驗資料\Wafer\OQC 日報表(STD)-Fab 2A.xlsm"
Workbooks.Open Filename:=gfilename, UpdateLinks:=0, ReadOnly:=True
Erase dataa
a = 0
For i = 4 To Sheets("Visual ").Range("A65536").End(xlUp).Row
If Sheets("Visual ").Cells(i, 1) >= data(0, 0, 0) - 2 Then
a = a + 1
dataa(a, 1) = Sheets("Visual ").Cells(i, 4) 'brick.no
dataa(a, 2) = Mid(Sheets("Visual ").Cells(i, 5), 1, (InStr(1, Sheets("Visual ").Cells(i, 5), "/", vbTextCompare) - 1)) ' wire.no
dataa(a, 3) = Sheets("Visual ").Cells(i, 70) 'IHI
dataa(a, 4) = Sheets("Visual ").Cells(i, 76) 'table
End If
Next
ActiveWorkbook.Close False
For i = 1 To 7
For j = 3 To Sheets(i).Range("A65536").End(xlUp).Row
For k = 1 To a
If Sheets(i).Cells(j, 1) = Mid(dataa(k, 1), 6, 4) + "_" + Mid(dataa(k, 1), 11, 2) Then
Sheets(i).Cells(j, 12) = dataa(k, 2)
Sheets(i).Cells(j, 13) = dataa(k, 3)
Sheets(i).Cells(j, 14) = dataa(k, 4)
End If
Next
Next
Next
For i = 1 To 7
For j = 3 To Sheets(i).Range("D65536").End(xlUp).Row
If Right(Sheets(i).Cells(j, 13), 1) = 2 Then
Sheets(i).Cells(j, 4).Interior.Color = RGB(255, 0, 0)
Sheets(i).Cells(j, 5).Interior.Color = RGB(255, 0, 0)
Sheets(i).Cells(j, 1).Interior.Color = RGB(255, 0, 0)
End If
Next
Next
gfilename = "M:\QC\檢驗資料\Wafer\OQC 日報表(特性)-COA-Fab 2A.xlsm"
Workbooks.Open Filename:=gfilename, UpdateLinks:=0, ReadOnly:=True
y = 0
For i = 4 To Sheets("Characteristic").Range("a65536").End(xlUp).Row
If FormatDateTime(Sheets("Characteristic").Cells(i, 1), vbShortDate) = data(0, 0, 0) Then
y = y + 1
dataaa(y, 1) = Sheets("Characteristic").Cells(i, 3) 'e+h brick.no
dataaa(y, 2) = Sheets("Characteristic").Cells(i, 10) 'e+h tav
dataaa(y, 3) = Sheets("Characteristic").Cells(i, 5) ' e+h ttv
dataaa(y, 4) = Sheets("Characteristic").Cells(i, 6) ' e+h warp
End If
Next
ActiveWorkbook.Close False
End Sub |
|
