0

我有工作表 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返回分配给工作表的date值W。例如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
4

2 回答 2

0

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

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 作为日期类型，日期在工作表中的格式无关紧要。

于 2013-02-12T23:09:34.107 回答
0

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

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

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

它将返回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。该函数注意到字符串并将其转换

Right now I am setting the range_lookup parameter to False. This means that there must be an exact match, and values that are not present will generate errors. If you prefer to return "the best match", then you set the parameter to True. Now the risk is that you will return garbage when the date requested is outside of your limits. You could solve this by setting the first and last value of the exchange rate column to "no valid data". When the lookup function returns, it will show this value.

于 2013-02-13T03:39:51.353 回答