stillfish00

回復 20# cdkee
插入一般模組，貼上下面code

1. Function FindMaxLoss(rngInput As Range, Optional order As Integer = 1)
   
2.     On Error GoTo ErrHandle
   
3.    
   
4.     Dim ar, arLoss
   
5.     ar = Application.Transpose(rngInput)
   
6.     ReDim arLoss(1 To UBound(ar))
   
7.    
   
8.     Dim i, count As Integer, sum As Double
   
9.     Dim indMin As Long, indMax As Long
   
10.     indMin = 1: indMax = 1
    
11.     i = 2
    
12.     Do While i <= UBound(ar)
    
13.         If ar(i) < ar(indMin) Then indMin = i
    
14.         If ar(i) > ar(indMax) Or i = UBound(ar) Then
    
15.             If indMin <> indMax Then
    
16.                 count = count + 1
    
17.                 arLoss(count) = ar(indMin) - ar(indMax)
    
18.                 i = indMin
    
19.             End If
    
20.             indMin = i
    
21.             indMax = i
    
22.         End If
    
23.         i = i + 1
    
24.         DoEvents
    
25.     Loop
    
26.         
    
27.     ReDim Preserve arLoss(1 To count)
    
28.     FindMaxLoss = Application.WorksheetFunction.Small(arLoss, order)
    
29.     Exit Function
    
30.    
    
31. ErrHandle:
    
32.     FindMaxLoss = CVErr(xlErrValue)
    
33. End Function

複製代碼

D7填上公式  =FindMaxLoss(D$20:D$34,1)
D8填上公式  =FindMaxLoss(D$20:D$34,2)
D9填上公式  =FindMaxLoss(D$20:D$34,3)
向右拖曳填滿公式

cdkee

回復 21# stillfish00

謝謝大大幫助!
測試後，發現第一最大失分，會以0減最大累計分數，請教如何修改?謝謝!

cdkee

回復 21# stillfish00

作了以下修改，謝謝各位大大幫忙!
D7填上公式  =FindMaxLoss(D$20:D$34,2)
D8填上公式  =FindMaxLoss(D$20:D$34,3)
D9填上公式  =FindMaxLoss(D$20:D$34,4)

VBALearner

回復 19# cdkee

我說您也稍微了解一下VBA基本的型態限制吧= ="
用integer無法計算到這麼大的數字，宣告變數要改成哪個型態網站上有寫
http://edisonx.pixnet.net/blog/post/42112370-vba-%E5%9F%BA%E6%9C%AC%E8%B3%87%E6%96%99%E5%9E%8B%E6%85%8B

cdkee

回復 24# VBALearner

仍然了解中，謝謝大大指導。

cdkee

回復 21# stillfish00

大大的沒有問題，今天正常了。

准提部林

還是有點看不懂，大約也寫一個：

1. Function GetLoseVal(xRng As Range, xInd%)
   
2. Dim Arr, xMin, i&, j&, k%, N%, xD
   
3. xMin = "":  GetLoseVal = "":  Arr = xRng.Value
   
4. Set xD = CreateObject("Scripting.Dictionary")
   
5. For i = 1 To UBound(Arr)
   
6. For j = i + 1 To UBound(Arr)
   
7.     If Arr(j, 1) >= Arr(i, 1) Then Exit For
   
8.     If Arr(j, 1) < xMin Then k = j: xMin = Arr(j, 1)
   
9. Next
   
10.     If xMin <> "" Then N = N + 1: xD(N) = xMin - Arr(i, 1): i = k: xMin = ""
    
11. Next
    
12. If xInd <= N Then GetLoseVal = Application.Small(xD.items, xInd)
    
13. End Function

複製代碼

Ｄ７公式：=GetLoseVal(D$20:D$34,ROW(A1))　右拉下拉
　
　

cdkee

還是有點看不懂，大約也寫一個：



Ｄ７公式：=GetLoseVal(D$20$34,ROW(A1))　右拉下拉
　
　
准提部林 發表於 2016-8-17 22:45

謝謝准提部林版大!是的，就是這樣。
請教大大，D7的公式中，用ROW(A1)有什麼作用?

准提部林

回復 28# cdkee


=ROW(A1)  >>>> = 1
下拉則遞增
=ROW(A2)  >>>> = 2
...
...

cdkee

回復 29# 准提部林

學多樣技巧，謝謝版大教導!