Excel VBA Fehler 400 mit großem Array (große Dateneingabe/-ausgabe)

Question

Ich schrieb das unten Makro in Excel (2010) VBA, um Markierungen zu Verträgen mit verschiedenen Problemen zu einem Master-Tracker hinzuzufügen. Bei einigen Größenprüfungen erhalte ich den Fehler 400, wenn ich versuche, mit einer Eingabe von 50.000 Verträgen (Array Contracts) zu laufen, aber es läuft gut mit 40.000 (dauerte etwa 14 Minuten). Irgendwelche Ideen, warum ich den Fehler bekomme? Kommentiert im Code, wo es bei 50.000 stoppt. Vielen Dank!

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

Das Umschreiben von Massenladungen und Massenentladung führt das Array aus. Ich habe ein Arbeitsblatt MATCH function für die Range.Find method ausgetauscht, da dort sollte garantiert übereinstimmen.

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, in Bezug auf Dim rgFound As Range; Deklarieren Sie keine Variable in einer Schleife. Deklarieren Sie es außerhalb der Schleife und weisen Sie ihm neue Werte innerhalb der Schleife zu.