09/08/04 12:56:01 +8vMetSY
>>396 URLﾘﾝｸ(r-hints.com)
ちなみに原理はURLﾘﾝｸ(r-hints.com)
398:こんな名無しでは、どうしようもないよ。
09/08/04 19:09:32 QEO4SHJI
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
399:こんな名無しでは、どうしようもないよ。
09/08/04 19:22:50 x2tIhfWt
>>397
ターゲットの中にもあるよ、そんな機能