[英]Run Time error 13 VBA Excel
I hope you are well I have some code see below. 希望您一切都好,下面有一些代码。 Essentially what it does is allows a user to upload two workbooks and it performs a Vlookup.
从本质上讲,它允许用户上载两个工作簿并执行Vlookup。 The Macro was working fine until the sheets went from 65,000 to 280,000 rows.
宏工作正常,直到工作表从65,000行增加到280,000行。 I first got the error 'run time 6 overflow' so I changed
我首先遇到错误“运行时6溢出”,所以我更改了
Dim intLastRow As Integer
to 至
Dim intLastRow As Double
That is when I got the Run Time error 13 on this line of code 那就是当我在这行代码中遇到运行时错误13时
.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
I know diming intLastRow As Double
has created a mismatch but do i dim intLastRow As Double
as something else or do i amend the code else where? 我知道将
intLastRow As Double
变暗会造成不匹配,但是我是否将intLastRow As Double
变暗为其他东西,还是在其他地方修改代码? Any help would be greatly appreciated. 任何帮助将不胜感激。 the rest of my code is below.
我的其余代码如下。
Sub Add_consent()
'Definition of used variables
Dim Directory As String 'Directory for inputs and outputs
Dim Consent_folder As String 'Directory for inputs and outputs
Dim inputFile As String 'Input file name
Dim currentInput As String 'Input file name
Const DELIMITER As String = "|" 'Values delimiter
Dim OutputFile As String 'Output file name
Dim lngCount As Long 'selected files count
Dim wbkOutput As Workbook 'output workbook
Dim wbkTemp As Workbook 'temporary workbook
Dim myWkBook As Workbook 'Input Workbook
Dim Consent As Workbook 'Consent file
Dim Consent_name 'new opened file
Dim myWkSheet As Worksheet 'Input Worksheet
Dim sheetNum As Long 'Variable for sheet number
Dim sheetNames() As String 'output worksheet sheet names
Dim sheetInterfaceName 'Sheet name representing DID interface
Dim Active As Worksheet 'Active worksheet
Dim intLastRow As Double 'Last Row Element
Dim Error_Codes As Worksheet ' Sheet containing error codes
Dim myRecord As Range 'Record for output
Dim myField As Range 'Cell value for output
Dim nFileNum As Long 'Variable for file number
Dim sOut As String 'Text to be written into file
Dim invalidDelete As String 'Case of invalid delete attempt
Dim sheetIndex As Long ' Current sheet index
Dim Selected As Long '
Dim rwCount As Long 'Number of current sheet rows containing data in tracking file
Dim colCount As Integer 'Number of current sheet columns containing data in tracking file
Dim extraCol As Integer 'Number of current sheet columns containing data in tracking file
Dim indexRow As Long 'Row index
Dim helpRow As Long '
Dim AddIn As Integer
Dim selectedCount As Integer
Dim int1 As Long
Dim int2 As Integer
Dim int3 As Integer
'General application settings
Application.ScreenUpdating = False 'Turns off switching to exported excel file once it gets opened
Application.DisplayAlerts = False 'Turns off automatic alert messages
Application.EnableEvents = False '
Application.AskToUpdateLinks = False 'Turns off the "update links" prompt
'User prompt, choose HCP file
MsgBox "Choose HCP/HCO file missing consent information"
'Alternative way to open the file
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
'Assign a number for the selected file
Dim FileChosen As Integer
FileChosen = fd.Show
If FileChosen <> -1 Then
'Didn't choose anything (clicked on CANCEL)
MsgBox "No file selected - aborted"
End 'Ends file fetch and whole sub
End If
Dim fss As Object
Set fss = CreateObject("Scripting.FilesystemObject")
inputFile = Dir(fd.SelectedItems(1)) 'parses only the name of file
Directory = fss.getParentFolderName(fd.SelectedItems(1)) & "\" 'parses only directory of the file
'Open HCP file .xlsx spreadsheet
Set wbkTemp = Workbooks.Open(Filename:=Directory & inputFile)
'Set wbkTemp = Workbooks(Workbooks.Count)
'Get number of columns in the HCP file
colCount = wbkTemp.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
'Get the number of rows in the HCP file
intLastRow = wbkTemp.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'Set GCM_ID format to number
wbkTemp.Sheets(1).Range(wbkTemp.Sheets(1).Cells(2, 1), wbkTemp.Sheets(1).Cells(intLastRow, 1)).Select 'Specify the range which suits your purpose
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
'Prompt user for the second file
MsgBox "Select file(s) containing Consent information"
'Open Consent file dialog
Dim filedial As FileDialog
Set filedial = Application.FileDialog(msoFileDialogOpen)
Dim chosen As Integer
chosen = filedial.Show
If chosen <> -1 Then
'Didn't choose anything (clicked on CANCEL)
MsgBox "No file selected - aborted"
End 'Ends file fetch and whole sub
End If
'Number of selected files
selectedCount = filedial.SelectedItems.Count
'Extra variable
AddIn = 0
For Selected = 1 To selectedCount
'Open file with Consent info
Consent_name = Dir(filedial.SelectedItems(Selected))
'Consent_folder
Workbooks.OpenText Filename:=Consent_name, StartRow:=1, DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|"
Set Consent = Workbooks(Workbooks.Count)
'Number of rows in consent file
rwCount = Consent.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'Specify the column to paste data
extraCol = colCount + AddIn + 1
'1)
'VLOOKUP across spreadsheets for consent data
'wbkTemp.Sheets(1).Cells(1, 1).Copy
'wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats
'wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent"
'With wbkTemp.Sheets(1)
'.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
'End With
'2)
'VLOOKUP across spreadsheets for consent data
'wbkTemp.Sheets(1).Cells(1, 1).Copy
'wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats
'wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent"
'With wbkTemp.Sheets(1)
' '.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
' For int1 = 2 To intLastRow
' if Application.WorksheetFunction.IsNA(Application.WorksheetFunction.VLookup(.Cells()))
'
' Next int1
'End With
'3)
'VLOOKUP across spreadsheets for consent data
wbkTemp.Sheets(1).Cells(1, 1).Copy
wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats
wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent"
With wbkTemp.Sheets(1)
.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False)
End With
'Close the file with consent information
Consent.Close
'Loop again for next file
AddIn = AddIn + 1
Next Selected
'Deal with N/A values
With wbkTemp.Sheets(1)
For int1 = 2 To intLastRow
For int2 = 1 To selectedCount
If Not Application.WorksheetFunction.IsNA(.Cells(int1, colCount + int2).Value) Then
.Cells(int1, colCount + 1).Value = .Cells(int1, colCount + int2).Value
End If
Next int2
Next int1
End With
'Remove extra columns
With wbkTemp.Sheets(1)
.Columns(fnColumnToLetter_Split(colCount + 2) & ":" & fnColumnToLetter_Split(extraCol + selectedCount)).Delete Shift:=xlToLeft
End With
'Save and close the new workbook
With wbkTemp
'Save and close the new workbook
.SaveAs Filename:=inputFile
.Close True
End With
MsgBox "Available consent information added"
End Sub
Function fnColumnToLetter_Split(ByVal intColumnNumber As Integer)
fnColumnToLetter_Split = Split(Cells(1, intColumnNumber).Address, "$")(1)
End Function
There seems to be an issue with passing more than 65536 Values as the first parameter in the VLookup function. 传递超过65536个值作为VLookup函数中的第一个参数似乎存在问题。
So this line of code will fail: 因此,这行代码将失败:
Range("L2:L80000").Value = Application.WorksheetFunction.VLookup(Range("A2:A80000").Value, Range("B:J"), 8, False)
But passing just a Range (and allowing VLookup to access the default Value property) is OK, so the following line of code will work: 但是只传递一个Range(并允许VLookup访问默认的Value属性)是可以的,因此下面的代码行将起作用:
Range("L2:L80000").Value = Application.WorksheetFunction.VLookup(Range("A2:A80000"), Range("B:J"), 8, False)
So, if you change your line to 因此,如果您将行更改为
.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)), Consent.Sheets(1).Range("B:J"), 8, False)
it should be OK. 应该没关系
PS As Philip Connell suggested, change the definition of intLastRow to be Long. PS如Philip Connell所建议,将intLastRow的定义更改为Long。 Being Double may not be the cause of this specific problem, but leaving it as Double will potentially cause you all sorts of other issues.
成为Double可能不是此特定问题的原因,但将其保留为Double可能会导致您遇到其他各种问题。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.