|
参考にして下さい。
端数処理やシートへのあてはめは、
そちらで対応してください。
Option Explicit
Dim higher As Double
Dim center As Double
Dim lower As Double
Function getRand(x As Double, y As Double) As Double
getRand = x + (y - x) * Rnd()
End Function
' 範囲内ならそのまま、範囲外なら補正してランダム値を返す
' opt=0: センターまでの間のランダム値
' opt=1: 上下限値寄りのランダム値
' opt=0: センター寄りのランダム値
Function getRandExt(x As Double, opt As Long) As Double
If x > higher Then
Select Case opt
Case 0: getRandExt = getRand(center, higher)
Case 1: getRandExt = getRand((center + higher) / 2, higher)
Case 2: getRandExt = getRand(center, (center + higher) / 2)
End Select
ElseIf x < lower Then
Select Case opt
Case 0: getRandExt = getRand(lower, center)
Case 1: getRandExt = getRand(lower, (lower + center) / 2)
Case 2: getRandExt = getRand((lower + center) / 2, center)
End Select
Else
getRandExt = x
End If
End Function
Sub test()
Dim ary(1 To 5) As Double
Dim k As Long
higher = 800.55555
center = 775.55555
lower = 750.55555
ary(1) = 810: ary(2) = 775: ary(3) = 815: ary(4) = 740: ary(5) = 750
For k = 1 To 5
Debug.Print getRandExt(ary(k), 0)
Next
Debug.Print "----慎重に戻す---------------"
For k = 1 To 5
Debug.Print getRandExt(ary(k), 1)
Next
Debug.Print "----大胆に戻す---------------"
For k = 1 To 5
Debug.Print getRandExt(ary(k), 2)
Next
End Sub
|
|