Hsieh

¦^´_ 1# joey77373
§AÁ|¨Òªºµª®×¦ü¥G»PÀɮפº®e¤£²Å
²Ä¤@ÃD­Y¬O¥H20%¬°°ò·ÇÀ³¸Ó¥u¦³C¡BE

²Ä¤GÃD¬O­n§ä¥XL:Qªº³Ì¤j­È¶Ü?¨ºÀ³¸Ó¬OC¤¸¥óªº­PÀù©Ê%¼Æ

1. Public Rng As Range
   
2. Sub ²Ä¤@ÃD()
   
3.     Dim myInput, i As Integer, Ar As Variant, MyMax#, MyStr
   
4.     Dim Str As String, Dic As Object
   
5.     myInput = InputBox("½Ð¿é¤JÁ`¦¾¬VªùÂe­È(%):")
   
6.     Set Dic = CreateObject("Scripting.Dictionary")
   
7.     For i = 2 To 9
   
8.     If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "½Ð¿é¤J¼Æ¦r": 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 "¨S¦³²Å¦X±ø¥óªº¤¸¥ó": 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

½Æ»s¥N½X

1. Sub ²Ä¤GÃD()
   
2. Dim MyMax#, MyStr$, MyTital$
   
3. If Rng Is Nothing Then MsgBox "¥¼¦³²Å¦X¤§¤¸¥ó¡A½Ð¥ý°õ¦æ²Ä¤@ÃD": Exit Sub
   
4. If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "¬°«D¼Æ­È¸ê®Æ": 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

½Æ»s¥N½X

²Ä¤TÃD´N¬Ý¤£¥X»P²Ä¤@¡B¤GÃD¦³¦óÃöÁp©Ê¡A½Ð¸Ô²Ó»¡©ú¤§

Hsieh

¦^´_ 5# joey77373

1. Public Rng As Range
   
2. Sub ²Ä¤@ÃD()
   
3.     Dim myInput, i As Integer, Ar As Variant, MyMax#, MyStr
   
4.     Dim Str As String, Dic As Object
   
5.     myInput = InputBox("½Ð¿é¤JÁ`¦¾¬VªùÂe­È(%):")
   
6.     Set Dic = CreateObject("Scripting.Dictionary")
   
7.     For i = 2 To 9
   
8.     If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "½Ð¿é¤J¼Æ¦r": 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 "¨S¦³²Å¦X±ø¥óªº¤¸¥ó": 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 ²Ä¤GÃD()
    
25. Dim MyMax#, MyStr$, MyTital$, MyCol%, Rw As Range
    
26. If Rng Is Nothing Then MsgBox "¥¼¦³²Å¦X¤§¤¸¥ó¡A½Ð¥ý°õ¦æ²Ä¤@ÃD": Exit Sub
    
27. If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "¬°«D¼Æ­È¸ê®Æ": Exit Sub
    
28. MyCol = InputBox("·Å«Ç®ÄÀ³%¼Æ=1" & Chr(10) & "¯ä®ñ®ø¯Ó%¼Æ=2" & Chr(10) & "»Ä¤Æ%¼Æ=3" & Chr(10) & "Àu¾i¤Æ%¼Æ=4" & Chr(10) & "­«ª÷ÄÝ%¼Æ=5" & Chr(10) & "­PÀù©Ê%¼Æ=6", "½Ð¿é¤JÄæ¦ì", 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 ²Ä¤TÃD()
    
35. Dim MyMax#, MyStr$, MyTital$, MyCol%
    
36. If Application.Count([Z2:Z4]) <> [Z2:Z4].Count Then MsgBox [Z2:Z4].SpecialCells(xlCellTypeConstants, 2).Address & "¬°«D¼Æ­È¸ê®Æ": Exit Sub
    
37. MyMax = Application.Min([Z2:Z4])
    
38. k = Application.Match(MyMax, [Z2:Z4], 0)
    
39. MsgBox "¤¸¥ó  " & [S1].Offset(k) & " Á`¦¾¬VÅv­«­È " & MyMax
    
40. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 7# joey77373
«e¨â­Ó°ÝÃD¬O§_¦³¹F¨ì§Aªº»Ý¨D?
²Ä¤T­Ó°ÝÃD¤´µM¬Ý¤£¥X»P«e¨â­Ó°ÝÃDªºÃöÁp©Ê
¬Oª½±µ¨ú±o³Ì¤p­È¨q¥X¡A»P«e­±ªº¿z¿ïµLÃö
­Y§Aªº»Ý¨D¨Ã¤£¬O¦p¦¹¡A½Ð¸Ô­z¨ä»P«e¨â­Ó°ÝÃDªºÃöÁp©Ê

Hsieh

¦^´_ 9# joey77373
¬O³o¼Ë¶Ü?

1. Public Rng As Range, MyMaxNum#, MyCol%, MyStr$
   
2. Sub ²Ä¤@ÃD()
   
3.     Dim myInput, i As Integer, Ar As Variant, MyMax# ', MyStr
   
4.     Dim Str As String, Dic As Object
   
5.     myInput = InputBox("½Ð¿é¤JÁ`¦¾¬VªùÂe­È(%):")
   
6.     Set Dic = CreateObject("Scripting.Dictionary")
   
7.     For i = 2 To 9
   
8.     If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "½Ð¿é¤J¼Æ¦r": 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 "¨S¦³²Å¦X±ø¥óªº¤¸¥ó": 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 ²Ä¤GÃD()
    
25. Dim MyTital$, Rw As Range
    
26. If Rng Is Nothing Then MsgBox "¥¼¦³²Å¦X¤§¤¸¥ó¡A½Ð¥ý°õ¦æ²Ä¤@ÃD": Exit Sub
    
27. If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "¬°«D¼Æ­È¸ê®Æ": Exit Sub
    
28. MyCol = InputBox("·Å«Ç®ÄÀ³%¼Æ=1" & Chr(10) & "¯ä®ñ®ø¯Ó%¼Æ=2" & Chr(10) & "»Ä¤Æ%¼Æ=3" & Chr(10) & "Àu¾i¤Æ%¼Æ=4" & Chr(10) & "­«ª÷ÄÝ%¼Æ=5" & Chr(10) & "­PÀù©Ê%¼Æ=6", "½Ð¿é¤JÄæ¦ì", 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 ²Ä¤TÃD()
    
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 "´À¥N¤¸¥ó " & Ch & [S1].Offset(, MyCol) & "­È= " & Test & "Á`¦¾¬VÅv­«­È= " & Temp
    
45. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 11# joey77373

1. Public Rng As Range, MyCol%, MyStr$
   
2. Sub ²Ä¤@ÃD()
   
3.     Dim myInput, i As Integer, Ar As Variant
   
4.     Dim Str As String, Dic As Object
   
5.     myInput = InputBox("½Ð¿é¤JÁ`¦¾¬VªùÂe­È(%):")
   
6.     Set Dic = CreateObject("Scripting.Dictionary")
   
7.     For i = 2 To 9
   
8.     If Not IsNumeric(Cells(i, 9)) Then MsgBox "I" & i & "½Ð¿é¤J¼Æ¦r": 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 "¨S¦³²Å¦X±ø¥óªº¤¸¥ó": 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 ²Ä¤GÃD()
    
25. Dim Rw As Range
    
26. If Rng Is Nothing Then MsgBox "¥¼¦³²Å¦X¤§¤¸¥ó¡A½Ð¥ý°õ¦æ²Ä¤@ÃD": Exit Sub
    
27. If Application.Count(Rng) <> Rng.Count Then MsgBox Rng.SpecialCells(xlCellTypeConstants, 2).Address & "¬°«D¼Æ­È¸ê®Æ": Exit Sub
    
28. MyCol = InputBox("·Å«Ç®ÄÀ³%¼Æ=1" & Chr(10) & "¯ä®ñ®ø¯Ó%¼Æ=2" & Chr(10) & "»Ä¤Æ%¼Æ=3" & Chr(10) & "Àu¾i¤Æ%¼Æ=4" & Chr(10) & "­«ª÷ÄÝ%¼Æ=5" & Chr(10) & "­PÀù©Ê%¼Æ=6", "½Ð¿é¤JÄæ¦ì", 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 & [K1].Offset(, MyCol) & Format(MyMaxNum, "0.00%")
    
33. End Sub
    
34. Sub ²Ä¤TÃD()
    
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) <= [A:A].Find(MyStr, lookat:=xlWhole).Offset(, MyCol) 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 "´À¥N¤¸¥ó " & Ch & [S1].Offset(, MyCol) & "­È= " & Test & "Á`¦¾¬VÅv­«­È= " & Temp
    
45. End Sub

½Æ»s¥N½X