VBA使用现有的代码Vlookup两个额外的列。

我希望你能帮上忙。 我在下面写了一些代码。 它所做的实质上是Vlookups在一张纸上的一列,并使用两张纸上的唯一标识符“客户ID”将其带入另一张纸上。 现在的代码只能将第一列从一个表格带到另一个表格。 我现在需要的代码也是从第二张图片列M和N列

我附上了图片,以便更好地理解。 因此,第一张图中的列AA是被列入该表的列I,现在我需要的代码是将列M和N 在这里输入图像说明 在这里输入图像说明

代码如下。 任何帮助将不胜感激。

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 Long '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 TOV 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, 4), .Cells(intLastRow, 4)), 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 

从本质上讲,所有你需要做的就是添加更多的vlookups,扩展到所使用的范围,并命名额外的列。 请参阅下面的代码的更新版本,其中应涵盖的要求。

 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 Long '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 TOV 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" wbkTemp.Sheets(1).Cells(1, extraCol + 1).Value = "Effective Date" wbkTemp.Sheets(1).Cells(1, extraCol + 2).Value = "End Date" With wbkTemp.Sheets(1) .Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:J"), 8, False) .Range(.Cells(2, extraCol+1), .Cells(intLastRow, extraCol + 1)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:N"), 12, False) .Range(.Cells(2, extraCol+2), .Cells(intLastRow, extraCol + 2)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:N"), 13, 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