Как выполнить расчет со случайными числами и сохранить набор чисел, который возвращает самую низкую дельту? - PullRequest
0 голосов
/ 07 июня 2019

Я пытаюсь обдумать, как выполнить серию вычислений с использованием случайных чисел и сохранить набор чисел, который возвращает наименьшую дельту из исходного набора данных.

Я пытаюсь воссоздать данные с использованием ограничений на случайные числа и хочу циклически перебирать случайные числа в течение заданного числа циклов, а затем преуспел в том, чтобы повторно заполнить данные набором случайных выборок, который имел наименьшую дельту изисходный набор данных.

Я вычисляю случайный набор данных, используя формулу AVERAGE исходных данных + RANDBETWEEN (-STDEV, STDEV).Дельта - это разница между исходными данными и набором случайных данных.

Сумма Дельта - это сумма дельт.

Дело не в том, что я ищу все отдельные случайные данные, которые соответствуют исходным данным, а общую сумму, соответствующую исходным данным.

Первый запуск выглядит следующим образом:

Example

Так что, когда случайное число пересчитывается, оно выглядит так:

enter image description here

Ответы [ 2 ]

0 голосов
/ 08 июня 2019

Итак, сделали некоторые предположения, но это простой пример того, что может вам помочь:

enter image description here

0 голосов
/ 07 июня 2019

может попробовать что-то вроде

Sub test()
Dim Ws As Worksheet, Rng As Range, Arr(1 To 6) As Variant, xSet As Variant
Dim ItrNo As Long, MinSum As Long, Rw As Long
Set Ws = ThisWorkbook.ActiveSheet
Set Rng = Ws.Range("A1:C8")
Application.Calculation = xlCalculationManual
MinSum = 100000


    Do While ItrNo < 100  ' change 100 according to your requirement
    Rng.Calculate
    xSet = Range("B2:B7").Value
        'next block is only for storing each sets from column J, delete if not required
        For Rw = 2 To 7
        Ws.Cells(Rw, ItrNo + 10).Value = xSet(Rw - 1, 1)
        Next

        If Ws.Range("C8").Value < MinSum Then
        MinSum = Ws.Range("C8").Value
            For Rw = 1 To 6
            Arr(Rw) = xSet(Rw , 1)
            Next
        End If
    ItrNo = ItrNo + 1
    Loop

Ws.Range("D2:D7").Value = Application.Transpose(Arr) 'place set resulting min Delta at column D , Change to requirement
Application.Calculation = xlCalculationAutomatic
End Sub

Диапазон A1: C8 взят для теста, измените Range, количество итераций и т. Д. По вашему требованию.

NB: есть несколько способов, с помощью которых можно достичь того же самого, но только что опубликовал то, что приходит на первый взгляд.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...