0
私はあなたがうまくいくことを願っています。基本的には、ユーザーが2つのブックをアップロードし、Vlookupを実行することができます。マクロは、シートが65,000行から280,000行になるまでうまくいっていました。私は、最初のエラー「実行時6オーバーフローは」私は、私はこのコード行にファイル名を指定して実行時エラー13を持っている実行時エラー13 VBA Excel
Dim intLastRow As Double
に
Dim intLastRow As Integer
を変更しました
.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)
私はdimingを知っていますintLastRow As Doubleは不一致を作成しましたが、他の何かとしてintLastRow As Doubleが暗くなっていますか？ ご協力いただければ幸いです。残りのコードは以下のとおりです。
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
Doubleが浮動小数点数であるため、明らかに型の不一致が発生するため、代わりに 'Dim intLastRow as Long'を使用してください。 – gizlmo
@ Gizmeiser：こんにちは、Dim 'intLastRow As Long'は残念ながらまだ動作しませんでしたその行のランタイムエラー13 –
@PhilipConnellあなたはあなたの 'VLookup'が失敗しなかったと確信していますか？変数型Variantを 'VLookup'に代入し、あなたが得るものを見てみてください。 Value、Consent.Sheets（1）.Range（ "B（応答なし）"、 "応答なし"、 "応答なし"、 "レスポンス= Application.WorksheetFunction.VLookup ：J "）、8、False）'それが失敗したかどうかを確認してください。 –