【関数】エクセルで競馬研究【グラフ】 ver3.0

>>396 http://r-hints.com/product.html

ちなみに原理はhttp://r-hints.com/

A1:A16に適切なオッズがあったとすると

Public Sub Main01()
Dim mo As Double, no As Double
Dim i As Integer
Dim r As Range

mo = Application.WorksheetFunction.Max(Range("A1:A16"))
no = Application.WorksheetFunction.Min(Range("A1:A16"))
Range("B1:E16").ClearContents

For Each r In Range("A1:A16")
i = 1
Do
If no = r.Value Then
Exit Do
ElseIf mo >= r.Value * i Then
i = i + 1
Else
i = i - 1
Range("B" & r.Row).Value = i * 100
Range("C" & r.Row).Value = "=a" & r.Row & "*b" & r.Row
Range("D" & r.Row).Value = "=rank(C" & r.Row & ",C1:C16,true)"
Exit Do
End If
Loop
Next r
Main02
End Sub

Public Sub Main02()
Dim m As Integer, s As Integer
Dim r As Range
Dim h As Integer

h = 10000 '目標値
s = Application.WorksheetFunction.Sum(Range("B1:B16"))

For Each r In Range("D1:D16")
If r.Value = 1 Then
If Range("C" & r.Row).Value - s < h Then
Range("B" & r.Row).Value = Range("B" & r.Row).Value + 100
Main02
Exit For
End If
End If
Next r
End Sub