如何用VBA编写调用外部文件VLOOKUP功能的自定义GetName公式

你提出的封装GetName自定义公式的需求完全可以实现，最终可以做到直接在单元格输入=GetName(A2)就实现和你给出的原生VLOOKUP完全一致的效果。

原有代码的问题 #

你现在写的代码有几个需要修正的点：

• Workbooks集合仅能识别当前已经在Excel中打开的工作簿，不支持直接传入相对路径读取未打开的文件，也不能自动解析相对路径
• 未加错误处理逻辑：当sku匹配不到时，WorksheetFunction.VLookup会直接抛出错误返回#VALUE!，和原生VLOOKUP返回#N/A的表现不一致
• 未开启自动重算：源文件数据更新后，自定义公式不会自动刷新结果

修正后的可用代码 #

方案1（最简单，要求源文件预先打开） #

如果使用时能保证General Database data.xlsx已经和当前工作簿同时打开，可以用以下代码，直接放在当前工作簿的模块中即可：

Public Function GetName(sku As String)
    ' 开启自动重算，源数据更新后公式自动刷新
    Application.Volatile True
    Dim myTableArray As Range
    ' 错误处理，匹配不到返回#N/A和原生VLOOKUP表现一致
    On Error Resume Next
    Set myTableArray = Workbooks("General Database data.xlsx").Worksheets("GD").Range("B:C")
    If Err.Number <> 0 Then
        GetName = "未找到源文件"
        Exit Function
    End If
    GetName = WorksheetFunction.IfError(WorksheetFunction.VLookup(sku, myTableArray, 2, False), CVErr(xlErrNA))
End Function

使用方法：直接在单元格输入=GetName(A2)即可，和你写的原生VLOOKUP效果完全一致。

方案2（支持读取未打开的源文件） #

如果不想每次使用都提前打开源文件，可以用下面的代码，需要替换为你自己的源文件绝对路径：

Public Function GetName(sku As String)
    Application.Volatile True
    Dim wb As Workbook
    Dim myTableArray As Range
    Dim filePath As String
    ' 替换为你的General Database data.xlsx的绝对路径，比如C:\Users\XXX\Desktop\General Database data.xlsx
    filePath = "C:\Users\你的用户名\Desktop\General Database data.xlsx"
    
    On Error Resume Next
    ' 先判断文件是否已经打开，没打开就后台打开
    Set wb = Workbooks("General Database data.xlsx")
    If Err.Number <> 0 Then
        Set wb = Workbooks.Open(filePath, ReadOnly:=True)
        wb.Windows(1).Visible = False
    End If
    
    Set myTableArray = wb.Worksheets("GD").Range("B:C")
    GetName = WorksheetFunction.IfError(WorksheetFunction.VLookup(sku, myTableArray, 2, False), CVErr(xlErrNA))
End Function

注意事项 #

• 如果要让这个自定义公式在所有工作簿都能调用，不要把代码放在当前工作簿的模块，要放在个人宏工作簿(PERSONAL.XLSB) 里
• 保存文件时要选择启用宏的格式（.xlsm/.xlsb），否则代码会丢失

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