麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] VBA 標準差問題 [打印本頁]

作者: taiwan16699 時間: 2015-4-22 11:19 標題: VBA 標準差問題

hi~各位高手們，小弟潛水已久，今日遇到vba標準差的問題想請教各位
以下是我的程式碼!!

問題在於我的rawdata是一排都是同樣整數時，標準差計算結果會正確並顯示為0
但一排為同樣小數時，則標準差會計算出E-17次方，請問該如何解決

附上檔案!!

Sub toolmeanstd()

Dim shTable As Worksheet
Set shTable = Sheets("Finaltable")
Set shraw = Sheets("data-tool")

TableEndR = shTable.Range("A65536").End(xlUp).Row
dataEndR = shraw.Range("H65536").End(xlUp).Row
dataEndC = shraw.Range("XDF1").End(xlToRight).Column

For R = 3 To TableEndR
      Set mappRng = shraw.Range("H1:XFD1").Find(Trim(shTable.Cells(R, 1)), LookAt:=xlWhole)

            If Not mappRng Is Nothing Then  '比對到資料
            mappC = mappRng.Column '(在mappRng範圍裡有幾個column)
            rowCnt = 0: dataSum = 0

            'shTable.Cells(R, 6) = shraw.Cells(1, mappC)

                  For R1 = 2 To dataEndR
                        rowCnt = rowCnt + 1
                        dataSum = dataSum + shraw.Cells(R1, mappC)
                        shTable.Cells(R, 6) = dataSum / rowCnt
                  Next

                  '歸零的目的在於怕之前有用到此變數，會造成程式異常

                  sigma = 0
                  For R2 = 2 To dataEndR
                     sigma = sigma + ((shraw.Cells(R2, mappC).Value - (dataSum / rowCnt)) ^ 2)
                  Next

                  stdValue = (sigma / (rowCnt - 1)) ^ 0.5
                  shTable.Cells(R, 7) = stdValue

            End If
Next

End Sub

作者: gn001038600 時間: 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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)