officeba > 单独文章

---

excel2010中的Extreme系列查找实例代码

excel2010中的Extreme系列查找实例代码，一个Excel和Access电力用户谁是与我们一起分享他的极端查找收集，以便我们能够使用Excel用户定义函数（UDF），他创建的增强查找功能。他的网站上daanalytics.com目前正在建设中，应该很快。

在Visual Basic编辑器，插入一个模块，并粘贴以下代码：
' XVLOOKUP (& XHLOOKUP)
' Works just like a vlookup (and hlookup) except that the user refers to a lookup colum (or row)' rather than a range, it is 0 based and the user can "look left" (or "look upward") by using a negative' column (or row) index.
' There is also an optional argument to allow the user to offset the cell to be returned by any number' of rows (or columns)
' I do not give users the option to choose between exact or approximate match - it is always exact

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
'looks up value in a range based on column and row headers
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
'Looks up value in a range and returns value of cell that is a specified number of rows and columns'away from lookup cells

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

声明：欢迎各大网站转载本站文章，还请保留一条能直接指向本站的超级链接，谢谢！

时间:2009-12-22 18:31:11,点击:65824