VBA-Excel和大型数据集导致程序崩溃

时间：2011-04-20 23:06:18

标签： excel optimization vba

第一次海报和一般的编程新手。我有一个项目，我必须建立一个财务模型来挖掘excel中的数据。我成功地在VBA上构建了这个模型。我已经对3,000行数据集进行了测试，并且成功了。我将简要解释它的作用。

我在多个交易所跟踪某一天的特定股票。我下载数据（大约935,000行）第一步是将给定交换的所有数据（大约290,000）复制到新工作表上（大约需要8分钟），然后我创建一个新列来记录出价请求差价（12secs） ），下一步是我遇到麻烦，我基本上将每行数据排名两次，一列为Bid尺寸，一列为Ask size。我创建了一个使用excel Percentile函数的函数，并根据给定的出价和要求大小的位置进行排名。截至目前，我已经运行了最后35分钟的宏并且还没有执行。我不能尝试其他宏，因为每个宏都依赖于前一个宏。

所以我的基本问题是，由于我的数据集很大，我的模型不断崩溃。使用测试数据时代码似乎没问题，并且在运行程序时不会抛出任何错误，但是更大的数据集它只是崩溃。有没有人有什么建议？这种大量数据是正常的吗？

提前致谢。 假

这是给我带来麻烦的子和函数，sub接受运行函数所需的输入，然后弹出到指定的单元格中。该代码假设重复三个单独的工作表的过程。目前，我喜欢它在一张纸上工作，因此使用的注释不包括循环

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" & lastRow)
   Set offerRange = .Range("G2:G" & lastRow)

    For counter = lastRow To firstRow Step -1

        Set bidScroll = .Range("F" & counter)
        Set offerScroll = .Range("G" & 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

3 个答案:

答案 0 :(得分：2)

935,000行是excel的很多。就像，真的很多。除非使用真实的数据库说，如果你的应用程序确实在每个单元格中放置了一个= Percentile（...），我建议尝试使用另一个工具。也许是VBA内部的一些东西。更一般地说，使用单元格之外的东西 - 然后将结果值存储在单元格中。维护那些与935k行数据相互依赖的公式有很多开销。

答案 1 :(得分：1)

问题在于您单独循环遍历每一行，Excel方法是尽可能尝试使用整个范围。我会将范围加载到数组中，然后修改DECILE_RANK代码以使用数组中的项。

请注意，读取范围的变量数组是2-D。

这是功能齐全的代码，包括我的自定义VBA阵列切片器。请注意，它仅在小型数据集上进行了测试：

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" & lastRow)
  offerArray = .Range("G2:G" & lastRow)

  Range("J2:J" & lastRow).Value = GetArraySlice2D(DECILE_RANK(bidArray), "column", 1, 1, 0)
  Range("K2:K" & 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

答案 2 :(得分：0)

我不确定这是否会直接解决您的问题，但您是否考虑过使用Application.ScreenUpdating = False？处理完数据后，请不要忘记将其设置为true。

相关问题
最新问题