VBA-Excel和大型数据集导致程序崩溃
第一次海报和一般编程新。 我有一个项目，我必须build立一个财务模型来挖掘excel中的数据。 我成功地在VBA上构build了这个模型。 我已经在3,000线数据集上进行了testing，并且成功了。 我将简要解释它的作用。
我在多个交易所的特定日子追踪给定的股票。 我下载的数据（大约935,000行）第一步是将一个给定的交易所（大约290,000）的所有数据复制到一个新的表（这大约需要8分钟），然后创build一个新的列logging买卖差价（12secs ），下一步是我有什么麻烦，我基本上sorting每行数据两次，一列的投标大小和一列的询问大小。 我创build了一个使用excel百分位数函数的函数，并根据给定的出价和询问大小的位置来进行排名。 到目前为止，我已经在最后的35分钟运行macros，还没有执行。 我不能尝试其他的macros，因为每个macros都依赖于前一个macros。
所以我的基本问题是，因为我的数据集很大，所以我的模型不断崩溃。处理testing数据时代码似乎很好，而且在运行程序时不会产生任何错误，但是使用更大的数据设置它只是崩溃。 有没有人有什么build议？ 如此大量的数据是否正常？
提前致谢。 假
这里是给我麻烦的子和function，子接受所需的input运行function，然后popup到指定的单元格。 代码是假设重复三个单独的工作表的过程。 现在，我喜欢它在一张纸上工作，因此使用注释不包括循环
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 问题是，你单独循环每一行，Excel的方式是尽可能一次尝试和整个范围的工作。 我会将范围加载到数组中，然后修改DECILE_RANK代码以处理数组中的项目。
请注意，读取范围的variables数组是二维的。
这里是function完整的代码，包括我自定义的VBA数组切片器。 请注意，它仅在小数据集上进行testing：
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
935,000行对于excel来说非常重要。 像，真的很多。 除非使用真正的数据库说，如果你的应用程序是从字面上把一个= Percentile（…）在每个单元格中，我会build议尝试使用另一个工具。 也许在VBA本身。 更一般地说，使用单元格外的东西 – 然后将结果值存储在单元格中。 在维护那些相互依赖935k行数据的公式方面有很多开销。
我不知道这是否会直接解决您的问题，但你有没有考虑使用Application.ScreenUpdating = False ？ 一旦数据处理完毕，不要忘记将其设置为true。