使VLookup能够更好地适应查找表中的结构变化

Question

关于内置的Excel函数：VLOOKUP（lookup_value，table_array，col_index_num，range_lookup）。

此功能在https://support.microsoft.com/en-gb/kb/181213

中描述

正如我们所知，如果在查找表的中间插入一列，此函数会开始给出错误的结果。这是因为col_index_num参数不会更改以适应您感兴趣的列之间的新偏移量。

当在VBA中使用vlookup函数时，问题变得更糟，其中table_array范围也缺乏响应查找表中的移动的能力。

问题：是否存在可以响应查找表中的结构更改而不会产生意外结果的备用函数（需要完全匹配）。

如果我的解决方案可能有用，我将回答我自己的问题 对其他人。

Answer 1

我已经编写了一个VBA函数（VLOOKUP2）来解决这个问题，但它确实要求查找表具有标题。该功能使用如下：

假设您在名为“People”的工作表中有一个3列查找表，标题为：名称，性别，年龄

您可以使用以下使用新VLOOKUP2功能的公式找到Sally的年龄：

=VLOOKUP2("People","Name","Age","Sally")

您可以按正常方式捕获失败的匹配，如下所示：

=IF(ISERROR(VLOOKUP2("People","Name","Age","Sally")),"Name not Found",VLOOKUP2("Prople","Name","Age","Sally"))

这是VBA代码：

 Public Function VLOOKUP2(Sheet, LeftHeading, RightHeading, SearchTerm) As Variant
 'This function will search a lookup table in the sheet specified by the 1st parameter 'Sheet'
 'The Columns in the sheet must have a row of column headings at the top (1:1)
 'The function will look for the 'SeachTerm' in the Column given by 'LeftHeading'
 'Once found the function will return the value found in the column given by 'RightHeading'
 'The function must be public so that the function can be called directly from a spreadsheet cell
 Application.Volatile (True) 'Needed so that spreadsheet auto-calculation will trigger function execution
 Set RangeLeft = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(LeftHeading, LookIn:=xlValues)
 Set RangeRight = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(RightHeading, LookIn:=xlValues)
 'We must use SET because a range is an object (not using set would recover the .value of the range)
 If RangeLeft Is Nothing Then
  VLOOKUP2 = "Error: Can't find heading '" + LeftHeading + "'"
 ElseIf RangeRight Is Nothing Then
  VLOOKUP2 = "Error: Can't find heading '" + RightHeading + "'"
 Else
  RangeRefLeft = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(LeftHeading, LookIn:=xlValues).Address
  RangeRefRight = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(RightHeading, LookIn:=xlValues).Address
  ColLeft = Split(RangeRefLeft, "$")(1) 'Converts $G$1 into G (for example)
  ColRight = Split(RangeRefRight, "$")(1) 'Converts $E$1 into E (for example)
  Cols = Asc(ColRight) - Asc(ColLeft) + 1 'Works out how many columns are between the two headings
  If Len(ColRight) > 1 Then
   VLOOKUP2 = "Error: Lookup tables beyond Column Z are not supported"
  ElseIf Cols < 2 Then
   VLOOKUP2 = "Error: Left heading ('" + LeftHeading + "' at column " + ColLeft + ") & right heading ('" + RightHeading + "' at column " + ColRight + ") are out of order"
  Else
   VlookupRange = ColLeft + ":" + ColRight 'Gives us G:E (for example)
   'Finally we use the built-in Vlookup spreadsheet function:
   VLOOKUP2 = Application.Vlookup(SearchTerm, ActiveWorkbook.Sheets(Sheet).Range(VlookupRange), Cols, False)
   'We use 'False' so that an exact match is required (Failed matches give an #NA error)
   'This function (VLOOKUP2) must return a variant so that #NA can be passed back as an error
  End If
 End If
End Function

Answer 2

捕捉失败的比赛：

=IFERROR(VLOOKUP2("People","Name","Age","Sally"),"Name not Found")

比你的例子短 - 如果有帮助的话。

Answer 3

这次略有不同。仍然使用在命名列标题下搜索的想法，以帮助VBA在查找表中意外移动的列中生存。这次虽然使用了FIND并返回了完全匹配的结果数组。我无法使FINDNEXT工作，而是使用After：=参数使用FIND，但要注意它何时包装。 我发现当其他VBA例程调用该函数时，返回的匹配数组很有用，尽管在电子表格单元格中用于返回第一个匹配时也很方便（例如下面的例子）。虽然有点笨拙，但列标题的使用似乎为整个代码提供了额外的“自我记录”。

Public Function FINDALL(Sheet, SearchHeading, SearchTerm, RetValHeading) As Variant()
 'This function searches under the given SearchHeading within the given sheet for matches against the SearchTerm
 'For each matching row it obtains the contents of the cell under the column given by the RetValHeading.
 'The values obtained are returned as an array. If the calling routine chooses to interpret the array as a single value then
 'it obtains the first match. If there are no matches then a "" string is returned (no error).
 'The Columns in the sheet must have a row of column headings at the top (1:1)
 'The function must be public so that the function can be called directly from a spreadsheet cell
 Dim RetValArray() As Variant ' We will grow the size of this array later using ReDim
 Application.Volatile (True) 'Needed so that spreadsheet auto-calculation will trigger function execution
 Set SearchRange = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(SearchHeading, LookIn:=xlValues, LookAt:=xlWhole)
 Set RetValRange = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(RetValHeading, LookIn:=xlValues, LookAt:=xlWhole)
 'We must use SET because a range is an object (not using set would recover the .value of the range)
 If SearchRange Is Nothing Then
  ReDim RetValArray(0): RetValArray(0) = "Error: Can't find heading '" + SearchHeading + "'"
 ElseIf RetValRange Is Nothing Then
  ReDim RetValArray(0): RetValArray(0) = "Error: Can't find heading '" + RetValHeading + "'"
 Else
  SearchHeadingRangeRef = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(SearchHeading, LookIn:=xlValues, LookAt:=xlWhole).Address
  SearchCol = Split(SearchHeadingRangeRef, "$")(1) 'Converts $G$1 into G (for example)
  SearchRangeRef = SearchCol + ":" + SearchCol 'Now: G:G
  Set SearchRange = ActiveWorkbook.Sheets(Sheet).Range(SearchRangeRef)
  RetValHeadingRangeRef = ActiveWorkbook.Sheets(Sheet).Range("1:1").Find(RetValHeading, LookIn:=xlValues, LookAt:=xlWhole).Address
  RetValCol = Split(RetValHeadingRangeRef, "$")(1) 'Converts $E$1 into E (for example)  Set SearchRange = ActiveWorkbook.Sheets(Sheet).Range(SearchRangeRef)
  On Error GoTo errorHandler
  Matches = 0: SearchWrapped = False
  Set CellFound = SearchRange.Find(SearchTerm, LookIn:=xlValues, LookAt:=xlWhole)
  If CellFound Is Nothing Then
   ReDim RetValArray(0): RetValArray(0) = ""
  Else
   CellFoundRef = CellFound.Address
   FirstCellFoundRef = CellFoundRef
   Do While Not SearchWrapped
    Matches = Matches + 1
    CellFoundRow = Split(CellFoundRef, "$")(2) 'Converts $G$5 into 5 (for example)
    RetValRef = RetValCol + CellFoundRow
    RetVal = ActiveWorkbook.Sheets(Sheet).Range(RetValRef).Value
    If IsEmpty(RetVal) Then RetVal = ""
    ReDim Preserve RetValArray(Matches - 1)
    RetValArray(Matches - 1) = RetVal
    Set CellFound = SearchRange.Find(SearchTerm, After:=CellFound, LookIn:=xlValues, LookAt:=xlWhole)
    CellFoundRef = CellFound.Address
    If CellFoundRef = FirstCellFoundRef Then SearchWrapped = True
   Loop
  End If
 End If
 FINDALL = RetValArray
Exit Function
errorHandler:
 ReDim RetValArray(0)
 RetValArray(0) = Err.Number + ": " + Err.Description
 FINDALL = RetValArray
End Function

这是一个示例查找表，其中包含在Cell G2中使用的函数： 在VBA中使用（0）获得第一个匹配，例如： FINDALL（“MySheet”，“Heading1”，SearchTerm，“Heading2”）（0）