excel vba错误400与大arrays（大数据input/输出）

我在Excel（2010）VBA中编写了下面的macros，将标记添加到主跟踪器的各种问题的合同中。 在进行一些大小testing的时候，当我尝试以50,000个合同（数组合同）的input运行时，我得到了错误400，但它运行正常，有40,000（花了大约14分钟）。 任何想法，为什么我得到错误？ 在代码中停留在50,000的地方评论。 谢谢！

Sub UploadNew() ''''''''''''''''''''''''Add All Contracts to End of Master''''''''''''''''''''''''''''''' 'Set up the array Contracts which will house the new contracts to be uploaded Dim Contracts() As String Dim size As Long Dim R As Integer Dim N As Long 'This sets up the value for N as the end of the current master list N = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1 'Determine size of array and store it into variable size size = Worksheets("Update").Cells(Rows.Count, "A").End(xlUp).Row - 1 'Identifies which Remediation column to add the marker to R = Application.WorksheetFunction.VLookup(Worksheets("Update").Range("F2"), Range("E14:G263"), 3, False) 'Having counted size we can redimension the array ReDim Contracts(size) 'Insert the values in column A into the array Dim i As Long For i = 1 To size Contracts(i) = Range("A1").Offset(i) Next i 'Takes each value in the array and adds it to the end of the master list using N For i = 1 To size Worksheets("Master").Range("A" & N).Value = Contracts(i) N = N + 1 Next i 'Remove the duplicates from the master tab based on the first column Worksheets("Master").Range("A:ZZ").RemoveDuplicates Columns:=Array(1) 'Remove blank rows from Master Dim rng As Range Set rng = Worksheets("Master").Range("A2:A" & N).SpecialCells(xlCellTypeBlanks) rng.EntireRow.Delete ''''''''''''''''''''''''Add All Contracts to End of Master''''''''''''''''''''''''''''''' '''''''''''''''''''''Place New Contract Marker for Each Contract''''''''''''''''''''''''' 'This searches all the contracts in the master and places a 1 R columns to the right of 'the found contract For i = 1 To size Dim rgFound As Range Set rgFound = Worksheets("Master").Range("A2:A" & N).Find(Contracts(i)) '! Code is stopping about here with 50,000 contracts, doesn't add a single marker !' With rgFound.Offset(, R) .Value = "1" .NumberFormat = "General" End With Next i '''''''''''''''''''''Place New Contract Marker for Each Contract''''''''''''''''''''''''' End Sub 

Answer 1

这重写批量加载和批量卸载数组。 我已经换出了Range.Find方法的工作表MATCH函数 ，因为应该保证匹配。

 Sub UploadNew() ''''''''''''''''''''''''Add All Contracts to End of Master''''''''''''''''''''''''''''''' 'Set up the array Contracts which will house the new contracts to be uploaded Dim Contracts As Variant Dim i As Long, N As Long, R As Integer With Worksheets("Update") 'Identifies which Remediation column to add the marker to 'I have no idea why you are looking up F2 in column E (and returning value from column G) on the Updates worksheet R = Application.WorksheetFunction.VLookup(.Range("F2"), .Range("E14:G263"), 3, False) 'AT THIS POINT R SHOULD BE AN INTEGER BETWEEN 2 and 16384 'NOT LARGER OR SMALLER OR TEXT 'CHECK WITH A WATCH WINDOW!!!!!!!!!!! 'Insert the values in column A into the array (SKIP HEADER ROW) Contracts = .Range(.Cells(2, "A"), .Cells(Rows.Count, "A").End(xlUp)).Value2 End With With Worksheets("Master") 'This sets up the value for N as the end of the current master list N = .Cells(Rows.Count, "A").End(xlUp).Row + 1 'Takes each value in the array and adds it to the end of the master list using N .Range("A" & N).Resize(UBound(Contracts, 1), UBound(Contracts, 2)) = Contracts 'Remove the duplicates from the master tab based on the first column .Range("A:ZZ").RemoveDuplicates Columns:=Array(1) 'Remove blank rows from Master If CBool(Application.CountBlank(.Range("A2:A" & N))) Then _ .Range("A2:A" & N).SpecialCells(xlCellTypeBlanks).EntireRow.Delete ''''''''''''''''''''''''Add All Contracts to End of Master''''''''''''''''''''''''''''''' '''''''''''''''''''''Place New Contract Marker for Each Contract''''''''''''''''''''''''' 'This searches all the contracts in the master and places a 1 R columns to the right of 'the found contract For i = LBound(Contracts, 1) To UBound(Contracts, 1) With .Cells(Application.Match(Contracts(i, 1), .Columns(1), 0), R) .Value = "1" .NumberFormat = "General" End With Next i End With '''''''''''''''''''''Place New Contract Marker for Each Contract''''''''''''''''''''''''' End Sub 

顺便说一句，关于Dim rgFound As Range ; 不要在循环中声明一个variables。 在循环之外声明它，并在循环内分配新的值。