Блог

Плакат для начинающих и новичок в программировании в целом. У меня есть проект, в котором я должен построить финансовую модель для майнинга данных в Excel. Мне удалось построить указанную модель на VBA. Я провел тесты для набора данных из 3000 строк, и они прошли успешно. Я кратко объясню, что это делает.

Я отслеживаю заданную акцию в заданный день на нескольких биржах. Я загружаю данные (примерно 935 000 строк) Первый шаг — скопировать все данные для данного обмена (примерно 290 000) на новый лист (это занимает примерно 8 минут), затем я создаю новый столбец для регистрации разброса ставок (12 секунд), следующий шаг — это то, с чем у меня возникли проблемы, я в основном ранжирую каждую строку данных дважды, один столбец для размера ставки и один столбец для размера запроса. Я создал функцию, которая использует функцию процентилей Excel и ранжирует на основе того, где находится заданный размер ставки и запроса. На данный момент я запускал макрос в течение последних 35 минут и еще не выполнил. Я не могу попробовать другие макросы, поскольку каждый макрос зависит от предыдущего.

Итак, моя основная проблема заключается в том, что, поскольку мой набор данных большой, моя модель продолжает сбоить.Код, кажется, работает нормально при работе с тестовыми данными, и он не выдает никаких ошибок при запуске программы, но с большим набором данных он просто вылетает. У кого-нибудь есть какие-либо предложения? Нормально ли это при таких больших объемах данных?

Заранее спасибо. Обман

Вот вспомогательный модуль и функция, которые доставляют мне проблемы, вспомогательный модуль принимает необходимые входные данные для запуска функции, а затем появляется в назначенной ячейке. Предполагается, что код повторяет процесс для трех отдельных листов. На данный момент я хотел бы, чтобы это работало на одном листе, поэтому использовал комментарии, чтобы не включать цикл

 Sub Bucketting()

Dim firstRow As Long
Dim lastRow As Long
Dim counter As Long
Dim bidRange As Range
Dim offerRange As Range
Dim bidScroll As Range
Dim offerScroll As Range
Dim Ex As String
Dim i As Integer

'For i = 1 To 1 Step 1 'Sheet Selection Process
 '   If i = 1 Then
  '      Ex = "Z"
   ' ElseIf i = 2 Then
    '    Ex = "P"
   ' Else
    '    Ex = "T"
   ' End If

Sheets("Z").Select 'Sheet selected

With ActiveSheet

    firstRow = .UsedRange.Cells(1).Row   1
    lastRow = .UsedRange.Rows.Count

   Set bidRange = .Range("F2:F" amp; lastRow)
   Set offerRange = .Range("G2:G" amp; lastRow)

    For counter = lastRow To firstRow Step -1

        Set bidScroll = .Range("F" amp; counter)
        Set offerScroll = .Range("G" amp; counter)

        With .Cells(counter, "J")
        .Value = DECILE_RANK(bidRange, bidScroll)
        End With

        With .Cells(counter, "K")
        .Value = DECILE_RANK(offerRange, offerScroll)
        End With

    Next counter

End With

Range("J1").Select
ActiveCell = "Bid Rank"

ActiveCell.Offset(0, 1) = "Offer Rank"

'Next i

End Sub

 Function DECILE_RANK(DataRange, RefCell)

    'Credit: BJRaid 
    'DECILE_RANK(The Range of data)
    'Declares the function that can be called in the spreadsheet cell  - enter '=DECILE_RANK(A5:A50,A5)

    'Using the percentile worksheet function calculate where the 10th, 20th etc percentile of the reference range are

    DEC1 = Application.WorksheetFunction.Percentile(DataRange, 0.1)
    DEC2 = Application.WorksheetFunction.Percentile(DataRange, 0.2)
    DEC3 = Application.WorksheetFunction.Percentile(DataRange, 0.3)
    DEC4 = Application.WorksheetFunction.Percentile(DataRange, 0.4)
    DEC5 = Application.WorksheetFunction.Percentile(DataRange, 0.5)
    DEC6 = Application.WorksheetFunction.Percentile(DataRange, 0.6)
    DEC7 = Application.WorksheetFunction.Percentile(DataRange, 0.7)
    DEC8 = Application.WorksheetFunction.Percentile(DataRange, 0.8)
    DEC9 = Application.WorksheetFunction.Percentile(DataRange, 0.9)


    ' Calculate the Decile rank that the reference cell value sits within

    If (RefCell <= DEC1) Then DECILE_RANK = 1
    If (RefCell > DEC1) And (RefCell <= DEC2) Then DECILE_RANK = 2
    If (RefCell > DEC2) And (RefCell <= DEC3) Then DECILE_RANK = 3
    If (RefCell > DEC3) And (RefCell <= DEC4) Then DECILE_RANK = 4
    If (RefCell > DEC4) And (RefCell <= DEC5) Then DECILE_RANK = 5
    If (RefCell > DEC5) And (RefCell <= DEC6) Then DECILE_RANK = 6
    If (RefCell > DEC6) And (RefCell <= DEC7) Then DECILE_RANK = 7
    If (RefCell > DEC7) And (RefCell <= DEC8) Then DECILE_RANK = 8
    If (RefCell > DEC8) And (RefCell <= DEC9) Then DECILE_RANK = 9
    If (RefCell > DEC9) Then DECILE_RANK = 10

End Function
  

935 000 строк — это много для Excel. Похоже, действительно много. Не говоря уже об использовании реальной базы данных, если ваше приложение буквально помещает = Процентиль (…) в каждую ячейку, я бы рекомендовал попробовать использовать для этого другой инструмент. Возможно, что-то внутри самой VBA. В более общем плане используйте что-то за пределами ячейки — затем сохраните результирующее значение в ячейке. Поддержка тех формул, которые взаимозависимы для 935 тыс. строк данных, сопряжена с большими накладными расходами.

Проблема в том, что вы перебираете каждую строку по отдельности, способ Excel — пытаться работать со всеми диапазонами сразу, когда это возможно. Я бы загрузил диапазоны в массивы, затем изменил ваш код DECILE_RANK для работы с элементами в массиве.

Обратите внимание, что массивы вариантов, в которых считываются диапазоны, являются 2d.

Вот полностью функционирующий код, включая мой пользовательский VBA array slicer. Обратите внимание, что это было протестировано только на небольшом наборе данных:

 Sub Bucketting()

Dim lastRow As Long
Dim bidArray As Variant
Dim offerArray As Variant

Sheets("Sheet1").Select 'Sheet selected

With ActiveSheet

  lastRow = .UsedRange.Rows.Count   1

  bidArray = .Range("F2:F" amp; lastRow)
  offerArray = .Range("G2:G" amp; lastRow)

  Range("J2:J" amp; lastRow).Value = GetArraySlice2D(DECILE_RANK(bidArray), "column", 1, 1, 0)
  Range("K2:K" amp; lastRow).Value = GetArraySlice2D(DECILE_RANK(offerArray), "column", 1, 1, 0)

End With

Range("J1").Select
ActiveCell = "Bid Rank"

ActiveCell.Offset(0, 1) = "Offer Rank"

End Sub

Function DECILE_RANK(DataRange As Variant) As Variant

' Credit:     BJRaid
' DECILE_RANK(The Range of data)
' Declares the function that can be called in the spreadsheet cell  - enter '=DECILE_RANK(A5:A50,A5)

Dim DEC(0 To 10) As Variant
Dim i As Integer, j As Integer

'Using the percentile worksheet function calculate where the 10th, 20th etc percentile of the reference range are
DEC(0) = 0
For i = 1 To 9
  DEC(i) = Application.WorksheetFunction.Percentile(DataRange, 0.1 * i)
Next i
DEC(10) = Application.WorksheetFunction.Max(DataRange)

' Calculate the Decile rank that the reference cell value sits within
For i = 1 To UBound(DataRange, 1)
  For j = 1 To 10
    If ((DataRange(i, 1) > DEC(j - 1)) And (DataRange(i, 1) <= DEC(j))) Then
      DataRange(i, 1) = j
      Exit For
    End If
  Next j
Next i

DECILE_RANK = DataRange

End Function

Public Function GetArraySlice2D(Sarray As Variant, Stype As String, Sindex As Integer, Sstart As Integer, Sfinish As Integer) As Variant

' this function returns a slice of an array, Stype is either row or column
' Sstart is beginning of slice, Sfinish is end of slice (Sfinish = 0 means entire
' row or column is taken), Sindex is the row or column to be sliced (NOTE:
' 1 is always the first row or first column)
' an Sindex value of 0 means that the array is one dimensional 3/20/09 Lance Roberts

Dim vtemp() As Variant
Dim i As Integer

On Err GoTo ErrHandler

Select Case Sindex
    Case 0
        If Sfinish - Sstart = UBound(Sarray) - LBound(Sarray) Then
            vtemp = Sarray
        Else
            ReDim vtemp(1 To Sfinish - Sstart   1)
            For i = 1 To Sfinish - Sstart   1
                vtemp(i) = Sarray(i   Sstart - 1)
            Next i
        End If
    Case Else
        Select Case Stype
            Case "row"
                If Sfinish = 0 Or (Sstart = LBound(Sarray, 2) And Sfinish = UBound(Sarray, 2)) Then
                    vtemp = Application.WorksheetFunction.Index(Sarray, Sindex, 0)
                Else
                    ReDim vtemp(1 To Sfinish - Sstart   1)
                    For i = 1 To Sfinish - Sstart   1
                        vtemp(i) = Sarray(Sindex, i   Sstart - 1)
                    Next i
                End If
            Case "column"
                If Sfinish = 0 Or (Sstart = LBound(Sarray, 1) And Sfinish = UBound(Sarray, 1)) Then
                    vtemp = Application.WorksheetFunction.Index(Sarray, 0, Sindex)
                Else
                    ReDim vtemp(1 To Sfinish - Sstart   1)
                    For i = 1 To Sfinish - Sstart   1
                        vtemp(i) = Sarray(i   Sstart - 1, Sindex)
                    Next i
                End If
        End Select
End Select
GetArraySlice2D = vtemp
Exit Function

ErrHandler:
    Dim M As Integer
    M = MsgBox("Bad Array Input", vbOKOnly, "GetArraySlice2D")

End Function
  

Я не уверен, что это напрямую решит вашу проблему, но рассматривали ли вы возможность использования Application.ScreenUpdating = False ? Не забудьте вернуть значение true после обработки ваших данных.