- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 257
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-11-28
              
|
12#
發表於 2013-6-4 23:40
| 只看該作者
回復 11# joey77373 - Public Rng As Range, MyCol%, MyStr$
- Sub 第一題()
- Dim myInput, i As Integer, Ar As Variant
- 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 Rw As Range
- If Rng Is Nothing Then MsgBox "未有符合之元件，請先執行第一題": Exit Sub
- If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "為非數值資料": Exit Sub
- MyCol = InputBox("溫室效應%數=1" & Chr(10) & "臭氧消耗%數=2" & Chr(10) & "酸化%數=3" & Chr(10) & "優養化%數=4" & Chr(10) & "重金屬%數=5" & Chr(10) & "致癌性%數=6", "請輸入欄位", 1)
- For Each Rw In Rng.Rows
- If Rw.Cells(, MyCol) > MyMaxNum Then MyMaxNum = Rw.Cells(, MyCol): MyStr = Cells(Rw.Row, 1)
- Next
- MsgBox "元件 " & MyStr & [K1].Offset(, MyCol) & Format(MyMaxNum, "0.00%")
- End Sub
- Sub 第三題()
- Dim A As Range, Temp#
- Set A = [S:S].Find(MyStr, lookat:=xlWhole)
- Temp = A.Offset(, 7)
- Do Until Left(A, 1) <> MyStr
- If A.Offset(, MyCol) <= [A:A].Find(MyStr, lookat:=xlWhole).Offset(, MyCol) Then
- If A.Offset(, 7) <= Temp Then Temp = A.Offset(, 7): Ch = A: Test = A.Offset(, MyCol)
- End If
- Set A = A.Offset(1)
- Loop
- MsgBox "替代元件 " & Ch & [S1].Offset(, MyCol) & "值= " & Test & "總汙染權重值= " & Temp
- End Sub
|
|
發表於 2013-6-4 23:18
| 
