12
返回列表 上一主題 發帖

[發問] 請問有msgbox用"物件查詢"巨集能幫小弟解決問題嗎?

joey77373

帖子
8 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
台灣-桃園 
註冊時間
2013-6-3 
最後登錄
2013-6-9 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-6-3 20:48 | 只看該作者

[發問] 請問有msgbox用"物件查詢"巨集能幫小弟解決問題嗎?

小弟目前正在編寫研究論文，目前就差最後一步驟論文就完成了。

教授要我在案例部分資料匯入excel，並使用內建vba寫的巨集補在最後一章，讓整個案例好看些

不過教授知道這不是我們專長領域，同意我詢問會vba的人協助

若版上有高手能幫助，小弟真是在感謝不過。

附件中小弟提問了3個指令的問題，第1題小弟有寫了一下但是跑出的答案無法從大致小排列，似乎少了些指令。


※附件中有2個檔案一個為word檔，裡面描述詢問問題，另一個檔案為excel例子資料，還有小弟電子信箱
   主要詢問關於"msgbox"巨集，與問題巨集設定給予範例指令參考，請過目。

關於Excel VBA請教.rar (17.84 KB)

關於Excel VBA請教

收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
105  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-5-7 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2013-6-3 23:42 | 只看該作者
回復 1# joey77373
你舉例的答案似乎與檔案內容不符
第一題若是以20%為基準應該只有C、E

第二題是要找出L:Q的最大值嗎?那應該是C元件的致癌性%數
  1. Public Rng As Range
  2. Sub 第一題()
  3.     Dim myInput, i As Integer, Ar As Variant, MyMax#, MyStr
  4.     Dim Str As String, Dic As Object
  5.     myInput = InputBox("請輸入總汙染門檻值(%):")
  6.     Set Dic = CreateObject("Scripting.Dictionary")
  7.     For i = 2 To 9
  8.     If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "請輸入數字": Exit Sub
  9.       If Cells(i, 9) >= (myInput / 1) Then
  10.          Dic(Cells(i, 1).Value) = Array(Cells(i, 9), Cells(i, 1))
  11.          If Rng Is Nothing Then Set Rng = Cells(i, "L").Resize(, 6) Else Set Rng = Union(Rng, Cells(i, "L").Resize(, 6))
  12.       End If
  13.     Next i
  14.     If Dic.Count = 0 Then MsgBox "沒有符合條件的元件": Set Rng = Nothing: Exit Sub
  15.     TestStr = Join(Dic.keys, ",")
  16.     Do Until Dic.Count = 0
  17.      Ar = Application.Transpose(Application.Transpose(Dic.items))
  18.      MyMax = Application.Max(Application.Index(Ar, , 1))
  19.      MyStr = Application.VLookup(MyMax, Ar, 2, 0)
  20.      MsgBox "元件  " & MyStr & "  " & MyMax
  21.      Dic.Remove MyStr
  22.     Loop
  23. End Sub
複製代碼
  1. Sub 第二題()
  2. Dim MyMax#, MyStr$, MyTital$
  3. If Rng Is Nothing Then MsgBox "未有符合之元件，請先執行第一題": Exit Sub
  4. If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "為非數值資料": Exit Sub
  5. MyMax = Application.Max(Rng)
  6. MyStr = Cells(Rng.Find(MyMax, lookat:=xlWhole).Row, "A")
  7. MyTital = Cells(1, Rng.Find(MyMax, lookat:=xlWhole).Column)
  8. MsgBox "元件  " & MyStr & MyTital & "  " & Format(MyMax, "0.00%")
  9. End Sub
複製代碼
第三題就看不出與第一、二題有何關聯性，請詳細說明之
學海無涯_不恥下問

TOP

joey77373

帖子
8 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
台灣-桃園 
註冊時間
2013-6-3 
最後登錄
2013-6-9 
3#
發表於 2013-6-4 00:54 | 只看該作者
首先，感謝Hsieh為小弟抽空相助，抱歉表達得不夠詳細，在下面補充說明！

第一題的部分因為excel稍做修正，word檔忘記更變答案，抱歉。

第二題的部分說明A至H元件在各汙染環境的影響%數，題目中所述之詢問
若使用者想找元件A至H"溫室效應"影響最嚴重的元件，則VBA給出的答案為"C元件"
若使用者想找元件A至H"重金屬"影響最嚴重的元件，則VBA給出的答案為"E元件"

第三題承接第二題，假如使用者在第二題詢問"溫室效應"影響最嚴重的元件
答案給出"C元件"
從第二題可以知道C元件是該產品元件中對"溫室效應"帶來的影響最大
所以使用者會去尋找可以替代"C元件"的元件，這也是第三題的論述
使用者從原先"C元件"與可以用來替代C元件的"元件C-1"、"元件C-2"
因為這些替代元件在"溫室效應"都比原先的低，所以使用者在第三題會比較這三個元件
對"整個環境汙染總權重值(也就是Z欄位的值)"，尋找車Z欄位值最低的元件為C-2
代表元件C-2是可以用來替代原先C元件的替代性元件。

不知道這樣敘述有沒有比較清楚，感謝花費時間幫忙。

TOP

joey77373

帖子
8 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
台灣-桃園 
註冊時間
2013-6-3 
最後登錄
2013-6-9 
4#
發表於 2013-6-4 01:11 | 只看該作者
回復 2# Hsieh
剛剛忘了用回復功能

提供的範例問題與Excel很好看出答案，因為真實數據上百筆關係到案例公司機密
所以只能用部分數據在此詢問感謝能提供指令讓小弟能順利執行。

TOP

joey77373

帖子
8 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
台灣-桃園 
註冊時間
2013-6-3 
最後登錄
2013-6-9 
5#
發表於 2013-6-4 13:58 | 只看該作者
回復 2# Hsieh

我補充一下，因為前面的描述我給有程式底子的朋友他們說看不懂
要我修改方式去描述
這樣講應該比較清楚

第二題想呈現的結果
延伸第一題的結果，比較L到Q各欄位的大小，例如：此時我輸入關注L欄位
則會去比較元件C的L欄位，跟元件E的L欄位之間大小，顯示出大的數值

第三題想呈現的結果
比較Z欄位的大小，選擇最小的

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
105  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-5-7 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2013-6-4 15:13 | 只看該作者
回復 5# joey77373
  1. Public Rng As Range
  2. Sub 第一題()
  3.     Dim myInput, i As Integer, Ar As Variant, MyMax#, MyStr
  4.     Dim Str As String, Dic As Object
  5.     myInput = InputBox("請輸入總汙染門檻值(%):")
  6.     Set Dic = CreateObject("Scripting.Dictionary")
  7.     For i = 2 To 9
  8.     If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "請輸入數字": Exit Sub
  9.       If Cells(i, 9) >= (myInput / 1) Then
  10.          Dic(Cells(i, 1).Value) = Array(Cells(i, 9), Cells(i, 1))
  11.          If Rng Is Nothing Then Set Rng = Cells(i, "L").Resize(, 6) Else Set Rng = Union(Rng, Cells(i, "L").Resize(, 6))
  12.       End If
  13.     Next i
  14.     If Dic.Count = 0 Then MsgBox "沒有符合條件的元件": Set Rng = Nothing: Exit Sub
  15.     TestStr = Join(Dic.keys, ",")
  16.     Do Until Dic.Count = 0
  17.      Ar = Application.Transpose(Application.Transpose(Dic.items))
  18.      MyMax = Application.Max(Application.Index(Ar, , 1))
  19.      MyStr = Application.VLookup(MyMax, Ar, 2, 0)
  20.      MsgBox "元件  " & MyStr & "  " & MyMax
  21.      Dic.Remove MyStr
  22.     Loop
  23. End Sub
  24. Sub 第二題()
  25. Dim MyMax#, MyStr$, MyTital$, MyCol%, Rw As Range
  26. If Rng Is Nothing Then MsgBox "未有符合之元件，請先執行第一題": Exit Sub
  27. If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "為非數值資料": Exit Sub
  28. MyCol = InputBox("溫室效應%數=1" & Chr(10) & "臭氧消耗%數=2" & Chr(10) & "酸化%數=3" & Chr(10) & "優養化%數=4" & Chr(10) & "重金屬%數=5" & Chr(10) & "致癌性%數=6", "請輸入欄位", 1)
  29. For Each Rw In Rng.Rows
  30.    If Rw.Cells(MyCol) > MyMax Then MyMax = Rw.Cells(MyCol): MyStr = Cells(Rw.Row, 1)
  31. Next
  32. MsgBox "元件  " & MyStr & "  " & Format(MyMax, "0.00%")
  33. End Sub
  34. Sub 第三題()
  35. Dim MyMax#, MyStr$, MyTital$, MyCol%
  36. If Application.Count([Z2:Z4]) <> [Z2:Z4].Count Then MsgBox [Z2:Z4].SpecialCells(xlCellTypeConstants, 2).Address & "為非數值資料": Exit Sub
  37. MyMax = Application.Min([Z2:Z4])
  38. k = Application.Match(MyMax, [Z2:Z4], 0)
  39. MsgBox "元件  " & [S1].Offset(k) & " 總汙染權重值 " & MyMax
  40. End Sub
複製代碼
學海無涯_不恥下問

TOP

joey77373

帖子
8 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
台灣-桃園 
註冊時間
2013-6-3 
最後登錄
2013-6-9 
7#
發表於 2013-6-4 16:19 | 只看該作者
回復 6# Hsieh


感謝Hsieh提供，剛剛輸入於Excel中run後，系統直接出現元件C-2總汙染權重值32.62

過程詢問視窗沒有出現，不知道是不是第二題部分的問題。

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
105  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-5-7 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2013-6-4 18:16 | 只看該作者
回復 7# joey77373
前兩個問題是否有達到你的需求?
第三個問題仍然看不出與前兩個問題的關聯性
是直接取得最小值秀出，與前面的篩選無關
若你的需求並不是如此，請詳述其與前兩個問題的關聯性
學海無涯_不恥下問

TOP

joey77373

帖子
8 
主題
1 
精華
0 
積分
18 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2010 
閱讀權限
10 
性別
男 
來自
台灣-桃園 
註冊時間
2013-6-3 
最後登錄
2013-6-9 
9#
發表於 2013-6-4 20:31 | 只看該作者
本帖最後由 joey77373 於 2013-6-4 20:32 編輯

回復 8# Hsieh

抱歉Hsieh大，應該是我描述的問題，我第三個問題的表格變動了一下這樣比較好描述我的問題

與第二題的關聯性是，當結果顯示"C元件"溫室效應%數最高"

所以從第三題的元件資料中尋找"C"的替代元件(S欄位)，從資料可以看到C有4個替代元件(C-1、C-2、C-3、C-4)

然後先比較替代元件的"溫室效應"(T欄位)的值有沒有比原本的高，高的排出(C-3、C-4)

剩下的替代元件(C-1、C-2)，尋找"總汙染權重值"(Z欄位)比較C-1與C-2選擇較小的值為答案。

範例資料.rar (12.18 KB)

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
105  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-5-7 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2013-6-4 22:47 | 只看該作者
回復 9# joey77373
是這樣嗎?
  1. Public Rng As Range, MyMaxNum#, MyCol%, MyStr$
  2. Sub 第一題()
  3.     Dim myInput, i As Integer, Ar As Variant, MyMax# ', MyStr
  4.     Dim Str As String, Dic As Object
  5.     myInput = InputBox("請輸入總汙染門檻值(%):")
  6.     Set Dic = CreateObject("Scripting.Dictionary")
  7.     For i = 2 To 9
  8.     If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "請輸入數字": Exit Sub
  9.       If Cells(i, 9) >= (myInput / 1) Then
  10.          Dic(Cells(i, 1).Value) = Array(Cells(i, 9), Cells(i, 1))
  11.          If Rng Is Nothing Then Set Rng = Cells(i, "L").Resize(, 6) Else Set Rng = Union(Rng, Cells(i, "L").Resize(, 6))
  12.       End If
  13.     Next i
  14.     If Dic.Count = 0 Then MsgBox "沒有符合條件的元件": Set Rng = Nothing: Exit Sub
  15.     TestStr = Join(Dic.keys, ",")
  16.     Do Until Dic.Count = 0
  17.      Ar = Application.Transpose(Application.Transpose(Dic.items))
  18.      MyMax = Application.Max(Application.Index(Ar, , 1))
  19.      MyStr = Application.VLookup(MyMax, Ar, 2, 0)
  20.      MsgBox "元件  " & MyStr & "  " & MyMax
  21.      Dic.Remove MyStr
  22.     Loop
  23. End Sub
  24. Sub 第二題()
  25. Dim MyTital$, Rw As Range
  26. If Rng Is Nothing Then MsgBox "未有符合之元件，請先執行第一題": Exit Sub
  27. If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "為非數值資料": Exit Sub
  28. MyCol = InputBox("溫室效應%數=1" & Chr(10) & "臭氧消耗%數=2" & Chr(10) & "酸化%數=3" & Chr(10) & "優養化%數=4" & Chr(10) & "重金屬%數=5" & Chr(10) & "致癌性%數=6", "請輸入欄位", 1)
  29. For Each Rw In Rng.Rows
  30.    If Rw.Cells(MyCol) > MyMaxNum Then MyMaxNum = Rw.Cells(MyCol): MyStr = Cells(Rw.Row, 1)
  31. Next
  32. MsgBox "元件  " & MyStr & "  " & Format(MyMaxNum, "0.00%")
  33. End Sub
  34. Sub 第三題()
  35. Dim A As Range, Temp#
  36. Set A = [S:S].Find(MyStr, lookat:=xlWhole)
  37. Temp = A.Offset(, 7)
  38. Do Until Left(A, 1) <> MyStr
  39.   If A.Offset(, MyCol) <= MyMaxNum Then
  40.      If A.Offset(, 7) <= Temp Then Temp = A.Offset(, 7): Ch = A: Test = A.Offset(, MyCol)
  41.   End If
  42.   Set A = A.Offset(1)
  43. Loop
  44. MsgBox "替代元件 " & Ch & [S1].Offset(, MyCol) & "值= " & Test & "總汙染權重值= " & Temp
  45. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 地上種了菜，就不易長草；心中有善，就不易生惡。
12
返回列表 上一主題