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换出工作表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

btw，关于Dim rgFound As Range;不要在循环中声明变量。在循环外声明它并在循环内为其赋值。

excel vba错误400与大数组（大数据输入/输出）

1 个答案: