无法获取WorksheetFunction类的VLookup属性问题求助

问题背景 #

尝试用VLookup从表格获取变量Lookup的值时，触发「无法获取WorksheetFunction类的VLookup属性」错误，怀疑列索引position设置有误，需求是根据rate_value的区间匹配对应值（如rate_value=200时返回0.4）。

现有代码 #

主逻辑代码 #

Dim Lookup As Double, rate_value As Double, sweep_value_min As Long, sweep_value_max As Long 
Lookup = GetRate(rate_value)
Select Case rate_value
    Case Is < 50
        sweep_value_min = rate_value - Lookup
        sweep_value_max = rate_value + Lookup
    Case 50 To 100
        sweep_value_min = rate_value - Lookup
        sweep_value_max = rate_value + Lookup
    Case Is > 100
        sweep_value_min = rate_value - Lookup
        sweep_value_max = rate_value + Lookup
End Select

GetRate函数代码 #

Function GetRate(rate As Variant) As Double
Dim wbSrc As Workbook, ws As Worksheet, position As Long

Set wbSrc = Workbooks.Open("C:\Users\Documents\LookupTable.xlsx")
Set ws = wbSrc.Worksheets("Rate")
Select Case rate
   Case Is < 50
       position = 2 
       GetRate = WorksheetFunction.VLookup(rate, ws.Range("A1:B4"), position, False)
   Case 50 To 100
       position = 3
       GetRate = WorksheetFunction.VLookup(rate, ws.Range("A1:B4"), position, False)
   Case Is > 100
       position = 4
       GetRate = WorksheetFunction.VLookup(rate, ws.Range("A1:B4"), position, False)
   Case Is = ""
       ErrorMsg = "No rate value. Can be found. Check before running again."
End Select
End Function

错误原因 #

1. 列索引超出范围：表格仅包含A、B两列（引用范围为A1:B4），但代码中position设置为3、4，超出有效列数，直接触发错误。
2. 匹配方式错误：使用精确匹配（False）时，rate_value（如200）不在A列的单元格值中，VLookup无法找到匹配项进而报错。
3. 工作簿未关闭：打开外部工作簿后未执行关闭操作，可能导致文件锁定或资源占用问题。
4. 缺失错误处理：未针对VLookup匹配失败的情况做容错处理。

修正方案 #

调整表格与匹配逻辑 #

确保Lookup表格的A列为升序排列的区间阈值（例如A1=0、A2=50、A3=100、A4=150），B列为对应的值（例如B1=0.2、B2=0.3、B3=0.4、B4=0.5），这样可以用近似匹配直接匹配区间。

修正后的GetRate函数 #

Function GetRate(rate As Variant) As Double
    Dim wbSrc As Workbook, ws As Worksheet
    Dim lookupRange As Range
    
    ' 处理空值情况
    If IsEmpty(rate) Or rate = "" Then
        MsgBox "未找到rate值，请检查后重试。"
        GetRate = 0
        Exit Function
    End If
    
    On Error Resume Next ' 启用错误捕获
    Set wbSrc = Workbooks("LookupTable.xlsx") ' 先检查文件是否已打开
    On Error GoTo 0
    
    ' 如果未打开则打开文件
    If wbSrc Is Nothing Then
        Set wbSrc = Workbooks.Open("C:\Users\Documents\LookupTable.xlsx")
    End If
    
    Set ws = wbSrc.Worksheets("Rate")
    Set lookupRange = ws.Range("A1:B4")
    
    On Error Resume Next
    ' 使用近似匹配（True），A列需升序
    GetRate = WorksheetFunction.VLookup(rate, lookupRange, 2, True)
    
    ' 处理匹配失败的情况
    If Err.Number <> 0 Then
        MsgBox "未找到对应rate的匹配值。"
        GetRate = 0
    End If
    
    ' 关闭工作簿（如果是我们打开的）
    If Not wbSrc.ReadOnly Then
        wbSrc.Close SaveChanges:=False
    End If
End Function

简化主逻辑（可选） #

由于三个Case的逻辑完全一致，可简化为：

Dim Lookup As Double, rate_value As Double, sweep_value_min As Long, sweep_value_max As Long 
Lookup = GetRate(rate_value)
sweep_value_min = rate_value - Lookup
sweep_value_max = rate_value + Lookup

内容的提问来源于stack exchange，提问作者user20114520