Question

我希望你能提供帮助。我在下面写了一些代码。它的作用基本上是一张表中的Vlookups三列，并使用Customer_id将它们带到另一张表中以执行查找它在过去完美地工作，但现在一些列已经更改了新列添加的位置，并且Vlookup无法引入信息。

第一张图片显示了存储三列Consent，Effective Date和End Date以及Vlookup列Custmer_Id的工作表。

图1

第二张图片显示了Customer_Id和三列被忽视的位置，但它们有#N / A而不是信息（隐藏了一些列以允许图片适合）

图2

我的代码如下。一如既往的任何帮助将不胜感激。

CODE

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, 4).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
    With wbkTemp.Sheets(1)
        .Cells(1, extraCol).Value = .Cells(1, 1).Value
        .Cells(1, extraCol).Value = "Consent"
        .Cells(1, extraCol + 2).Value = "Effective Date"
        .Cells(1, extraCol + 3).Value = "End Date"
        .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 + 2), .Cells(intLastRow, extraCol + 2)).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)).NumberFormat = "dd/mm/yyyy"
        .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:N"), 13, False)
        .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).NumberFormat = "dd/mm/yyyy"
    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

Answer 1

碰巧，我上周遇到了这个确切的情况，并在vlookup help site

找到答案

* VLOOKUP和索引匹配之间的一个很大区别是，如果您在查找数据中插入列，则索引匹配将自动更新。因此，如果您的查找表可能会发生变化，您可能需要考虑使用索引匹配。这是索引匹配公式的结构：

= index（WhichColumnToReturnValueFrom，（匹配（SearchForValue，SearchColumn，0） = INDEX（列我想要一个返回值，（MATCH（我的查找值，我希望查找的列，ZeroForExactMatch）*

来源：http://www.excelvlookuphelp.com/what-can-index-match-do-that-vlookup-cant/

Answer 2

所以我到底得到了答案

第一个变化就在这里

'Get the number of rows in the HCP file
intLastRow = wbkTemp.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row

成为

'Get the number of rows in the HCP file
intLastRow = wbkTemp.Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row

第5列是我们需要查看Customer_id

的最后一个条目的列

代码的第二个更改是

原始代码

 'VLOOKUP across spreadsheets for consent data
    With wbkTemp.Sheets(1)
        .Cells(1, extraCol).Value = .Cells(1, 1).Value
        .Cells(1, extraCol).Value = "Consent"
        .Cells(1, extraCol + 2).Value = "Effective Date"
        .Cells(1, extraCol + 3).Value = "End Date"
        .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 + 2), .Cells(intLastRow, extraCol + 2)).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)).NumberFormat = "dd/mm/yyyy"
        .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:N"), 13, False)
        .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).NumberFormat = "dd/mm/yyyy"
    End With
    'Close the file with consent information
    Consent.Close

新代码

 'VLOOKUP across spreadsheets for consent data
    With wbkTemp.Sheets(1)
        .Cells(1, extraCol).Value = .Cells(1, 1).Value
        .Cells(1, extraCol).Value = "Consent"
        .Cells(1, extraCol + 2).Value = "Effective Date"
        .Cells(1, extraCol + 3).Value = "End Date"
        .Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 5), .Cells(intLastRow, 5)), Consent.Sheets(1).Range("A:J"), 9, False)
        .Range(.Cells(2, extraCol + 2), .Cells(intLastRow, extraCol + 2)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 5), .Cells(intLastRow, 5)), Consent.Sheets(1).Range("A:N"), 12, False)
        .Range(.Cells(2, extraCol + 2), .Cells(intLastRow, extraCol + 2)).NumberFormat = "dd/mm/yyyy"
        .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 5), .Cells(intLastRow, 5)), Consent.Sheets(1).Range("A:N"), 13, False)
        .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).NumberFormat = "dd/mm/yyyy"
    End With
    'Close the file with consent information
    Consent.Close

这些更改现在意味着查找正在查找正确的列

列更改后VBA Vlookup无法正常工作

2 个答案: