excel vba 错误 400 with large array（大数据输入/输出）

Question

我在 Excel (2010) VBA 中编写了以下宏，以将标记添加到具有各种问题的合约中，并将其添加到主跟踪器中。在进行一些规模测试时，当我尝试运行输入 50,000 个合约（数组合约）时出现错误 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

此重写批量加载和批量卸载数组。我换了一个工作表 MATCH function for the Range.Find method 因为应该可以保证匹配。

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；不要在循环中声明变量。在循环外声明它并在循环内为其赋新值。

excel vba 错误 400 with large array（大数据输入/输出）

excel vba error 400 with large array (large data input / output)

testing

size

excel

vba