- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 197
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-9-7
              
|
2#
發表於 2013-6-3 23:42
| 只看該作者
回復 1# joey77373
你舉例的答案似乎與檔案內容不符
第一題若是以20%為基準應該只有C、E
第二題是要找出L:Q的最大值嗎?那應該是C元件的致癌性%數- Public Rng As Range
- Sub 第一題()
- Dim myInput, i As Integer, Ar As Variant, MyMax#, MyStr
- Dim Str As String, Dic As Object
- myInput = InputBox("請輸入總汙染門檻值(%):")
- Set Dic = CreateObject("Scripting.Dictionary")
- For i = 2 To 9
- If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "請輸入數字": Exit Sub
- If Cells(i, 9) >= (myInput / 1) Then
- Dic(Cells(i, 1).Value) = Array(Cells(i, 9), Cells(i, 1))
- If Rng Is Nothing Then Set Rng = Cells(i, "L").Resize(, 6) Else Set Rng = Union(Rng, Cells(i, "L").Resize(, 6))
- End If
- Next i
- If Dic.Count = 0 Then MsgBox "沒有符合條件的元件": Set Rng = Nothing: Exit Sub
- TestStr = Join(Dic.keys, ",")
- Do Until Dic.Count = 0
- Ar = Application.Transpose(Application.Transpose(Dic.items))
- MyMax = Application.Max(Application.Index(Ar, , 1))
- MyStr = Application.VLookup(MyMax, Ar, 2, 0)
- MsgBox "元件 " & MyStr & " " & MyMax
- Dic.Remove MyStr
- Loop
- End Sub
- Sub 第二題()
- Dim MyMax#, MyStr$, MyTital$
- If Rng Is Nothing Then MsgBox "未有符合之元件，請先執行第一題": Exit Sub
- If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "為非數值資料": Exit Sub
- MyMax = Application.Max(Rng)
- MyStr = Cells(Rng.Find(MyMax, lookat:=xlWhole).Row, "A")
- MyTital = Cells(1, Rng.Find(MyMax, lookat:=xlWhole).Column)
- MsgBox "元件 " & MyStr & MyTital & " " & Format(MyMax, "0.00%")
- End Sub
|
|
發表於 2013-6-4 01:11
| 
