Как создать загрузчик с использованием массивов?

#arrays #excel #vba #statistics-bootstrap

#массивы #excel #vba #статистика-bootstrap

Вопрос:

Я пытаюсь создать загрузчик с использованием массивов.

У меня есть набор данных из двух запасов с данными в столбцах B и C:

16/08/2016  79.84   70.87
15/08/2016  80.26   71.79
12/08/2016  80.22   71.7
11/08/2016  80.56   71.98
10/08/2016  80.55   71.21
09/08/2016  81.5    73.05
08/08/2016  81.6    72.25
05/11/1990  17.5625 6.4011
02/11/1990  17.0938 6.4358
01/11/1990  17      6.5137
31/10/1990  16.8438 6.583
30/10/1990  17.3438 6.4444
29/10/1990  17.7813 6.3232

Мне нужно случайным образом выбрать 10000 раз из столбца C, получить среднее значение и отобразить в ячейке D1. Затем сгенерируйте случайные 10000 раз и отобразите в D2 и т. Д. Аналогично для E1, E2, …, En, но на основе данных в столбце C.

Поскольку наборы данных большие, с двумя или более запасами, а методология требует много запусков, простая печать среднего значения каждый раз для каждой ячейки занимает много времени. Итак, мне нужно использовать массивы. Я могу сделать это «вручную», но я уверен, что есть лучший способ.

Выполнение кода занимает много времени, поскольку он каждый раз печатается в электронной таблице. Я сохраняю смоделированные значения в simval() массиве, но он удаляется при повторном создании.

В идеале я хочу перенести данные в массив, смоделировать новое распределение и распечатать результаты рядом с исходными данными.

 Sub bstrap()
Dim miRange As Range
Dim avgsimvals() As Double, simval() As Double
Dim start As Double, secs As Double
start = Timer
r = Range("A1").CurrentRegion.Rows.Count
c = 4
Set miRange = Range(Cells(1, 2), Cells(r, 2))
For j = 1 To 100 '100 runs takes over 90 secs, approx 2.5 hrs for 10,000
    ReDim simval(1 To r)
    For i = 1 To r
        simval(i) = WorksheetFunction.Index(miRange, r * Rnd()   1)
        Cells(i, c).Value = simval(i)
    Next i
    c = c   1
Next j

secs = Round(Timer - start, 6)
MsgBox "run in " amp; secs, vbInformation

End Sub
  

Ответ №1:

использовать массивы

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

 Option Explicit

Sub bstrap2()
    Dim start As Double
    Dim dataSet As Variant

    start = Timer
    With Worksheets("Boostrap")
        dataSet = Application.Transpose(.Range("B1:B" amp; .Cells(.Rows.Count, 1).End(xlUp).Row).Value)
        Range("D1") = GetRandomizedAverage(dataSet, 10000)

        dataSet = Application.Transpose(.Range("C1:C" amp; .Cells(.Rows.Count, 1).End(xlUp).Row).Value)
        Range("E1") = GetRandomizedAverage(dataSet, 10000)
    End With

    MsgBox "run in " amp; Round(Timer - start, 6), vbInformation
End Sub

Function GetRandomizedAverage(dataSet As Variant, repetitions As Long) As Double
    Dim i As Long, j As Long, r As Long

    r = UBound(dataSet)
    ReDim simval(1 To repetitions, 1 To r)

    For j = 1 To repetitions
        For i = 1 To r
            simval(j, i) = dataSet(Int(r * Rnd()   1))
        Next i
    Next j
    GetRandomizedAverage = WorksheetFunction.Average(simval)
End Function
  

Комментарии:

1. Привет, спасибо за быстрый ответ. Я понимаю, что это непонятно, извиняюсь за это. Однако вы поняли, чего я хочу. У меня более 6500 строк данных в столбцах B и C, цены на акции. Я хочу сгенерировать аналогичный набор данных, то есть 6500 строк, используя метод повторной выборки. Ваш код не запускается на моем компьютере, выдает ошибку «не хватает памяти», и после того, как я изменил 10000 до 1000, потребовалось 7 секунд, чтобы сгенерировать две ячейки данных. Я хочу сгенерировать данные с помощью повторной выборки для заполнения диапазона («D1: E6500»). Интересно, будет ли этот код эффективным для этой цели? Еще раз спасибо.

2. Пожалуйста, более подробно описывайте необходимые вычисления. И при сообщении об ошибках всегда указывайте, какая строка их выдает.

Ответ №2:

Позвольте мне начать с некоторых комментариев. Во-первых, вы можете рассмотреть возможность использования любого другого языка, как только начнете выполнять моделирование. VBA не известен своими быстрыми вычислениями. Во-вторых (хотя и не по теме), почему вы хотите загружать данные временных рядов?
В-третьих, известно ли вам о том, что ваш собственный код не выполняет желаемых вычислений? Это просто запись случайно нарисованного наблюдения на рабочий лист. Усреднение нигде не выполняется.

Теперь к моему ответу. Вот фрагмент кода, который выполняется достаточно быстро. Выполнение 10000 симуляций для 6500 строк в 2 столбцах занимает около 5 минут. Неплохо, мирового рекорда тоже нет.

Самый важный элемент, который вы также можете увидеть в коде @user3598756, заключается в том, что вы сначала помещаете каждое смоделированное значение в массив. Последним шагом является запись массивов на рабочий лист. Чем меньше отдельных частей, в которых данные записываются на рабочий лист, тем лучше, так как это основной источник медлительности.

* P.S. этот код упрощен и должен быть сделан более надежным, если используется.

 Sub Bootstrap()

Const NSIM As Long = 100#
Const COL_START As Long = 4
Const COL_END As Long = 5

Dim rng_output As Range, rng_input As Range, ws As Worksheet
Dim i As Long, j As Long, nRows As Long, dCol As Long
Dim sim_vals() As Variant, sim_avg() As Variant
Dim start As Double

start = Timer

Set ws = ActiveSheet                'change to appriopriate sheet if needed

nRows = ws.UsedRange.Rows.Count
dCol = COL_START

Set rng_input = ws.Range(ws.Cells(1, dCol - 2), ws.Cells(nRows, dCol - 2))

Do While dCol < COL_END   1
    ReDim sim_vals(1 To NSIM)
    ReDim sim_avg(1 To nRows)
    
    For j = 1 To nRows
        For i = 1 To NSIM
            sim_vals(i) = rng_input(Int(nRows * rnd()   1))
        Next i
        sim_avg(j) = Application.WorksheetFunction.Sum(sim_vals) / NSIM
    Next j
    
    ws.Range(ws.Cells(1, dCol), ws.Cells(nRows, dCol)) = Application.WorksheetFunction.Transpose(sim_avg)
    dCol = dCol   1
    Set rng_input = ws.Range(ws.Cells(1, dCol - 2), ws.Cells(nRows, dCol - 2))
Loop

MsgBox "Code took " amp; Round(Timer - start, 2) amp; " seconds to run"

End Sub