- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2014-4-13 15:14
| 只看該作者
本帖最後由 GBKEE 於 2014-4-13 19:32 編輯
回復 5# 518587 - Option Explicit
- Sub Ex()
- Dim Rng(1 To 2) As Range, i As Integer
- Dim f(1 To 7), Xik(1 To 7)
- Dim ii As Integer
- On Error Resume Next '程式碼有錯誤時 繼續下一行程式碼(不理會)
- With ActiveSheet '指定工作表
- .Range("D:k") = ""
- .Range("b:b").Cells.Replace 1, "=aaa", lookat:=xlWhole '範圍中的儲存格值 = 1, 修改為不存在的公式,造成錯誤值
- Set Rng(1) = .Range("b:b").SpecialCells(xlCellTypeFormulas, xlErrors) '設定變數為這範圍中有錯誤值的特殊儲存格
- Rng(1).Value = 1 '特殊儲存格的值恢復 = 1
- End With
- With Rng(1)
- For i = 1 To .Areas.Count 'Areas 屬性 傳回 Areas 集合，此集合代表多重範圍中的所有範圍
- With .Areas(i).Cells(1, 2).Resize(7) '一週次數量範圍
- '.Cells(1,2) 'D欄 ** 1.先計算周一到周七的平均數 = AvgOld
- .Cells(1, 2) = Application.Average(.Cells)
- 'AvgOld
- A:
- '.Cells(1,3) 'E欄 ** 2.將 原本數量 減掉AvgOld=Xik 加上絕對值(出現七個數)
- For ii = 1 To 7 '.Cells(ii, 1) C欄: 原本數量
- '.Cells(1,7) 'I欄 ** 6.ck=(-(Dpk^2)/ln(Ri)) (出現一個數)
- .Cells(ii, 3) = Abs(.Cells(ii, 1) - .Cells(1, 2))
- 'Xik
- Xik(ii) = .Cells(ii, 3) '
- Next
-
- '.Cells(1,4) 'F欄 ** 3.找出週一到周七最大值減掉AvgOld=Dpk (出現一個數)
- .Cells(1, 4) = Application.Max(.Cells) - .Cells(1, 2)
- 'Dpk
-
- '.Cells(1,5) 'G欄 ** 4.找出週一到周七最小值減掉AvgOld=Dnk (絕對值) (出現一個數)
- .Cells(1, 5) = Abs(Application.Min(.Cells) - .Cells(1, 2))
- 'Dnk
-
- '.Cells(1,6) 'H欄 ** 5.Dnk/Dpk=Ri (出現一個數)
- .Cells(1, 6) = .Cells(1, 5) / .Cells(1, 4)
- 'Ri
-
- '*** 到 A578 時 H578 = 1 Ln(.Cells(1, 6))=0
- '*** 分母=0 不可除 的錯誤 ***************
- '*** 接下的數字會有錯誤 ***************
- '.Cells(1,7) 'I欄 ** 6.ck=(-(Dpk^2)/ln(Ri)) (出現一個數)
- .Cells(1, 7) = -(.Cells(1, 4) ^ 2) / Application.Ln(.Cells(1, 6))
- 'ck
-
- '.Cells(1,8) 'J欄 ** 7.f=exp(-(Xik^2)/ck) (出現七個數)
- For ii = 1 To 7
- .Cells(ii, 8) = Application.Evaluate("Exp(" & -(Xik(ii) ^ 2) / .Cells(1, 7) & ")")
- 'f
- 'VBA 不支援 工作表函數 Exp
- 'Evaluate 方法 將 Microsoft Excel 名稱轉換成物件或者值。
- f(ii) = .Cells(ii, 8)
- Next
-
- '.Cells(1,9) K欄 ** 8.W=f/f的加總 (出現七個數)
- For ii = 1 To 7
- .Cells(ii, 9) = f(ii) / Application.Sum(f)
- 'W
- Next
- '.Cells(1,10) L欄 ** 9.AvgNew=SUMPRODUCT(W*原始數量) (出現一個數)
- Set Rng(2) = .Cells(1, 9).Resize(7) 'W 的範圍
- .Cells(1, 10) = Application.SumProduct(Rng(2), .Cells) 'AvgNew
- '10.如果 AvgOld-AvgNew>0.1 (加上絕對值)的話 ，新的平均值就必須取代舊的，然後回到第二步重複計算到小於0.1
- 'If Abs(.Cells(1, 2) - .Cells(1, 9)) > 0.1 Then GoTo A: '回到第2步驟
- '*********?????????????????????
- '然後回到第二步重複計算到小於0.1
- '如何計算到小於0.1??
- '*******************************
- End With
- Next
- End With
- End Sub
|
|
發表於 2014-4-12 15:33
| 
