fork download
  1. Option Explicit
  2.  
  3. Sub 乱数設定()
  4. Dim ws As Worksheet
  5. Set ws = ActiveSheet
  6. Dim wcol As Long
  7. Dim i As Long
  8. Dim randval As Variant
  9. randval = GetRandArray(8, 19, 4, 2)
  10. i = 1
  11. For i = 1 To 4
  12. wcol = i + 1
  13. ws.Cells(3, wcol).Value = randval(i)
  14. Next
  15. End Sub
  16. 'ランダムな整数を配列にして返す関数
  17. 'sn:整数の最小値
  18. 'en:整数の最大値
  19. 'size:配列のサイズ(配列の要素数)(配列の添え字は1から開始する)
  20. 'diff:隣り合う要素間の差の最小値
  21. Private Function GetRandArray(ByVal sn As Long, ByVal en As Long, ByVal size As Long, ByVal diff As Long) As Variant
  22. Const try_limit As Long = 10000 'トライ回数上限
  23. Dim isUsed() As Boolean '使用済み整数
  24. Dim randval() As Long '戻り値用配列(ランダムな整数の配列)
  25. Dim i As Long '作業変数
  26. Dim x As Long 'randval用添え字
  27. Dim num As Long '取得したランダム数
  28. Dim try_count As Long: try_count = 0 'トライ回数カウンター
  29. ReDim isUsed(0 To en - sn) '配列の確保(0始まり)
  30. ReDim randval(1 To size) '配列の確保(1始まり)
  31. '配列の先頭から順に整数を割り当てる
  32. For x = 1 To size
  33. '割り当てが完了するまで繰り返す
  34. Do While (True)
  35. 'sn~enの範囲でランダムな整数を取得する
  36. num = Application.RandBetween(sn, en)
  37. 'トライ回数が上限を超えた場合、戻り値用配列に全て0を設定し、強制終了する
  38. try_count = try_count + 1
  39. If try_count > try_limit Then
  40. For i = 1 To size
  41. randval(i) = 0
  42. Next
  43. Exit For
  44. End If
  45. '取得した整数が未使用なら、割り当てを行う
  46. If isUsed(num - sn) = False Then
  47. Dim isValid As Boolean: isValid = False '有効か否かの判定
  48. '先頭の要素は、無条件に有効とする
  49. If x = 1 Then
  50. isValid = True
  51. Else
  52. '隣の要素との差が、diff以上ならなら有効とする
  53. If Abs(num - randval(x - 1)) >= diff Then
  54. isValid = True
  55. End If
  56. End If
  57. '取得した整数が有効なら、その整数を割り当てる
  58. If isValid = True Then
  59. isUsed(num - sn) = True
  60. randval(x) = num
  61. Exit Do
  62. End If
  63. End If
  64. Loop
  65. Next
  66. '戻り値用配列を戻り値に設定する
  67. GetRandArray = randval
  68. End Function
  69.  
Not running #stdin #stdout 0s 0KB
stdin
Standard input is empty
stdout
Standard output is empty