从 excel 2007 函数中搜索多个工作表

Question

我有工作表 A、B 和 C。工作表 A 包含一个带日期的列。 B 和 C 各包含两列：一列包含日期，一列包含值。例如

工作表 A：

     A           B
1    2001-01-01  ---
2    2001-01-02  ---

工作表 B：

     A           B
1    2001-01-01  1

工作表 C：

     A           B
1    2001-01-02  2

我想要一个函数=Search(W, date)，当从工作表A 运行时，它返回分配给工作表W 中date 的值。例如Search(C, "2001-01-02")=2。

这是在给定日期搜索货币汇率的抽象版本：多个工作表包含货币汇率，因此当我们搜索时，我们知道要选择哪个工作表（货币）。

如何定义这样的函数？我尝试将参数传递给自定义宏，但 excel 不断给我神秘的错误。使用使用选定单元格作为源的宏似乎很容易，但函数会更好。

编辑：我的尝试，不起作用

Function FindRate()
    Dim FindString As String
    Dim Rate As String
    Dim Src As Range
    Dim Found As Boolean

    MsgBox sheet_name
    Rate = "Not found "
    Set Src = Application.ActiveCell
    FindString = "2006-12-19"
    Sheets("cur CHF").Activate
    Found = False
    For Each c In [A1:C2000]
        If c.Value = FindString Then
            Rate = c.Offset(0, 1).Value
            Found = True
            Exit For
        End If
        Next

    MsgBox Rate
    'FindRate = Rate
End Function



Function Rate(cname As String)
    Dim sheet_name As String
    Dim c2s As New Collection

    c2s.Add "cur worksheet name", "cur"

    sheet_name = c2s.Item(cname)
    Call FindRate(sheet_name)

End Function

Answer 1

您真正在做的是查找。 Excel 中内置了一个VLOOKUP 函数，可以完全满足您的需求。语法是

VLOOKUP(lookup_value, table_array, col_index_num, [range_lookup])

这将在表table_array 中查找值lookup_value。如果range_lookup 为假，它将在第一列中找到精确匹配，否则它将找到最接近的值（更快，但必须对数据进行排序）。

它将返回col_index_num 列中的值。

在您的情况下，如果您希望工作表 B 中的值对应于“2012-01-01”，您会这样做

=VLOOKUP("2012-01-01", Sheet2!A2:B1000, 2, false)

您可能不得不将日期字符串转换为日期值，等等。如果您已将 Sheet2 上的值添加为日期，您会想要使用

=VLOOKUP(DATEVALUE("2012-01-01"), Sheet2!A2:B1000, 2, false)

因为该函数正确地将 字符串 "2012-01-01" 转换为 Excel 识别为 DATE 的内容。

现在，如果您先验不知道需要访问哪个工作表（因为这是一个变量），您可能必须自己编写一个 VBA 函数：

Function myLookup(value, curr)
Dim dval As Long, luTable As Range, s As Worksheet, c As Range

' if user types date as string, convert it to date first...
If VarType(value) = vbString Then
  dval = DateValue(value)  ' this doesn't work if dval hasn't been declared as `long`!
Else
  dval = value
End If

' see if `curr` is the name of a defined range; if so, use it
On Error GoTo notArange
' if the next line doesn't generate an error, then the named range exists:
Set luTable = Range(curr)
' so let's use it...
GoTo evaluateFunction

notArange:
' If we got here, "curr" wasn't the name of a range... it must be the name of a sheet
' first, tell VBA that we're done handling the last error:
Resume here
here:
On Error GoTo noSheet
Set s = ActiveWorkbook.Sheets(curr)

Dim firstCell As Range, lastCell As Range
Set firstCell = s.Range("a1")
Set lastCell = s.Range("b1").End(xlDown) ' assuming data in columns A and B, and contiguous
Set luTable = Range(firstCell, lastCell)

evaluateFunction:
myLookup = Application.WorksheetFunction.VLookup(dval, luTable, 2, False)
Exit Function

noSheet:
' get here if currency not found as either sheet or range --> return an error message
myLookup = curr & " not found!"

End Function

这已经在一个小样本上进行了测试，并且有效。需要注意的几点：

您可以命名保存转换的范围（“欧元”、“第纳尔”、“日元”...），而不是将每个范围保存在单独的工作表上。然后，您可以将范围名称（为方便起见，使其与货币名称相同）作为参数传递给您的函数，并使用Range(currency) 访问它。这也解决了“硬连线”范围大小的问题

该函数将检查命名范围是否存在，如果存在则使用它。如果没有，它将寻找具有正确名称的工作表

如果使用“无效货币名称”，这将反映在返回值中（所以myLookup("01-01-2012", "Florins") 将返回"Florins not found!"

我没有假设一个特定长度的查找表，而是使用End(xlDown) 构造动态确定表的大小

我允许将日期作为String 或DATEVALUE 传递。该函数注意到字符串并对其进行转换

现在我将range_lookup 参数设置为False。这意味着必须存在完全匹配，并且不存在的值将产生错误。如果您希望返回“最佳匹配”，则将参数设置为True。现在的风险是，当请求的日期超出您的限制时，您将退回垃圾。您可以通过将汇率列的第一个和最后一个值设置为“无有效数据”来解决此问题。当查找函数返回时，它会显示这个值。

Answer 2

这是一个简单的 FindCell 函数，我经常使用它只是扩展了 Excel 的搜索功能，但你所拥有的应该很适合。它返回一个范围，但是从返回范围中获取值很简单。我按如下方式使用它（为您添加了 cmets）：

Function FindCell(SearchRange As Range, SearchText As Variant, OffsetDown As Integer, OffsetRight As Integer) As Range

    'Do a normal search range call using the passed in range and text.
    'First try looking formula
    Set FindCell = SearchRange.Find(What:=SearchText, LookAt:=xlWhole, LookIn:=xlFormulas, _
        MatchCase:=True, SearchOrder:=xlByRows).Offset(OffsetDown, OffsetRight)

    'If nothing is found then look in values
    If FindCell Is Nothing Then
            Set FindCell = SearchRange.Find(What:=SearchText, LookAt:=xlWhole, LookIn:=xlValue, _
            MatchCase:=True, SearchOrder:=xlByRows).Offset(OffsetDown, OffsetRight)
    End If
End Function

这可以用作速率函数（您当然可以将这两个函数结合起来，但我在许多应用程序中都使用 FindCell，因此将其分开）：

Function GetRate(sWorksheetName As String, theDate As Date) As Double
    Dim returnRange As Range

    'Call the FindCell function specifying the range to search (column A), and the date and then offset one cell to the right for the value
    Set returnRange = FindCell(ThisWorkbook.Worksheets(sWorksheetName).Columns("A:A"), sDate, 0, 1)

    'Check if we've found something. If its Nothing then we haven't
    If Not returnRange Is Nothing Then GetRate = returnRange.Value
End Function

你可以像这样在 Sub 中测试它：

Sub Test()
    MsgBox "Value is " & GetRate("Sheet2", "2001-01-01")
End Sub

通过接受 GetRate 作为日期类型，日期在工作表中的格式无关紧要。