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

时间:2013-02-12 21:40:29

标签: excel vba

我有工作表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

2 个答案:

答案 0 :(得分:0)

这是一个简单的FindCell函数我使用很多只是扩展Excels搜索功能但是从你得到的应该适合。它返回一个范围,但是它很容易从返回范围中获取值。我按如下方式使用它(为了您的利益添加了注释):

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

答案 1 :(得分: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

这已在小样本上进行了测试,并且有效。有几点需要注意:

您可以指定保留转换的范围(“euro”,“dinar”,“yen”,...),而不是将每个保留在单独的工作表上。然后,您可以传递范围的名称(为方便起见,使其与货币名称相同)作为函数的参数,并使用Range(currency)访问它。这也解决了“硬连线”范围大小的问题

该函数将检查命名范围是否存在,并在存在时使用它。如果没有,它将查找具有正确名称的表单

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

我没有假设某个长度的查找表,而是使用End(xlDown)构造

动态确定表的大小

我允许将日期作为StringDATEVALUE传递。该函数注意到字符串并将其转换为

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