VBA扩展Excel查找功能的4个Lookup函数

这里水文工具集列出几个VBA实现的增强Excel查找功能的Lookup函数(XVLookup、XHLookup、XLookup、XVHLookup)，可以实现带偏移单元格查找及基于列和行标题的区域内查找，具体源代码如下：

' 除了引用查找列(或行)而不是区域外,与VLookup(和HLookup)一样.
' 基于0,用户可以通过使用负的列(或行)索引值"查找左侧"(或"向上查找").
' 也有一个可选的参数,允许用户偏移单元格,偏移数由行(或列)的数值返回.
' 没有为用户提供选择精确匹配还是大致匹配 - 总是精确匹配.

Function XVLOOKUP(Lookup_Column As Range, Lookup_Value As Variant, Column_Index As Integer, _
    Optional Row_Offset As Integer)
 
    Dim DCol, DRow As Integer
    Dim DSheet, strCRange, strARange As String
    Dim ARange As Range
 
 
    DCol = Lookup_Column.Column
    DCol = DCol + Column_Index
 
    If IsMissing(Row_Offset) Then
        Row_Offset = 0
    End If
 
    DSheet = Lookup_Column.Parent.Name
    strCRange = Lookup_Column.Address
 
    DRow = WorksheetFunction.Match(Lookup_Value, Worksheets(DSheet).Range(strCRange), 0)
    DRow = DRow + (Lookup_Column.Row - 1) + Row_Offset
 
    Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol))
    strARange = ARange.Address
 
    XVLOOKUP = Worksheets(DSheet).Range(strARange).Value
 
End Function
 
Public Function XHLOOKUP(Lookup_Row As Range, Lookup_Value As Variant, Row_Index As Integer, _
    Optional Column_Offset As Integer)
 
    Dim DCol, DRow As Integer
    Dim DSheet, strRRange, strARange As String
    Dim ARange As Range
 
 
    DRow = Lookup_Row.Row
    DRow = DRow + Row_Index
 
    If IsMissing(Column_Offset) Then
        Column_Offset = 0
    End If
 
    DSheet = Lookup_Row.Parent.Name
    strRRange = Lookup_Row.Address
 
    DCol = WorksheetFunction.Match(Lookup_Value, Worksheets(DSheet).Range(strRRange), 0)
    DCol = DCol + (Lookup_Row.Column - 1) + Column_Offset
 
    Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol))
    strARange = ARange.Address
 
    XHLOOKUP = Worksheets(DSheet).Range(strARange).Value
 
End Function
 

'XLOOKUP
'查找区域内的值
'返回偏离查找单元格的指定数字的行和列数的单元格值
Public Function XLOOKUP(Lookup_Range As Range, Lookup_Value As Variant, _
    Row_Offset As Integer, Column_Offset As Integer)
 
    Dim DRow, DCol As Integer
    Dim DSheet, DAddress, strARange As String
    Dim ARange As Range
 
    DRow = Lookup_Range.Find(Lookup_Value).Row
    DCol = Lookup_Range.Find(Lookup_Value).Column
 
    DRow = DRow + Row_Offset
    DCol = DCol + Column_Offset
 
    DSheet = Lookup_Range.Parent.Name
 
    Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol))
    strARange = ARange.Address
 
    XLOOKUP = Worksheets(DSheet).Range(strARange)
 
End Function

'XVHLOOKUP
'在基于列和行标题的区域内查找值
Public Function XVHLOOKUP(Lookup_Range As Range, Row_Header As Variant, Column_Header As Variant)
 
    Dim DCol, DRow, TRow, BRow, LCol, RCol As Integer
    Dim DSheet, strCRange, strRRange, strARange As String
    Dim CRange, RRange, ARange As Range
    DSheet = Lookup_Range.Parent.Name
 
    TRow = Lookup_Range.Row
    BRow = TRow + Lookup_Range.Rows.Count - 1
 
    LCol = Lookup_Range.Column
    RCol = LCol + Lookup_Range.Columns.Count - 1
 
    Set CRange = Range(Cells(TRow, LCol), Cells(BRow, LCol))
    strCRange = CRange.Address
 
    DRow = WorksheetFunction.Match(Row_Header, Worksheets(DSheet).Range(strCRange), 0)
    DRow = DRow + Lookup_Range.Row - 1
 
    Set RRange = Range(Cells(TRow, LCol), Cells(TRow, RCol))
    strRRange = RRange.Address
 
    DCol = WorksheetFunction.Match(Column_Header, Worksheets(DSheet).Range(strRRange), 0)
    DCol = DCol + Lookup_Range.Column - 1
 
    Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol))
    strARange = ARange.Address
 
    XVHLOOKUP = Worksheets(DSheet).Range(strARange).Value
 
End Function