Daniel’s Extreme Lookup Collection
Daniel Wiesenfeld创建了一些Excel自定义函数,扩充查找功能。
在VBE中,插入模块并粘贴下列代码:
' 除了引用查找列(或行)而不是区域外,与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 '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 '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


