Excel VBA如何定义可执行SQL查询的公共函数并制作成加载项

修正后可直接使用的公共函数 #

Public Function getData(idRng As Range, colsRng As Range) As Variant
    Dim conn As Object, rs As Object
    Dim strQuery As String, colStr As String, idStr As String
    Dim cell As Range, resArr As Variant, i As Long, j As Long
    
    ' 拼接查询字段列表
    For Each cell In colsRng
        If colStr <> "" Then colStr = colStr & ","
        colStr = colStr & "[" & cell.Value & "]"
    Next
    
    ' 拼接ID查询条件
    For Each cell In idRng
        If idStr <> "" Then idStr = idStr & ","
        ' 如果ID是数值类型可去掉外层单引号，文本类型保留即可
        idStr = idStr & "'" & cell.Value & "'"
    Next
    
    ' 创建数据库连接
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "DSN=SumitODBC"
    
    ' 拼接完整SQL语句
    strQuery = "SELECT " & colStr & " FROM [Sheet1$A1:Z500] WHERE id IN (" & idStr & ")"
    Set rs = conn.Execute(strQuery)
    
    ' 将查询结果转为数组返回，适配工作表函数输出要求
    If Not rs.EOF Then
        resArr = rs.GetRows
        ' 转置数组适配Excel行列展示逻辑
        ReDim outputArr(0 To UBound(resArr, 2), 0 To UBound(resArr, 1))
        For i = 0 To UBound(resArr, 2)
            For j = 0 To UBound(resArr, 1)
                outputArr(i, j) = resArr(j, i)
            Next
        Next
        getData = outputArr
    Else
        getData = "无匹配数据"
    End If
    
    ' 释放资源
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
End Function

封装为全局可用加载项步骤 #

• 按Alt+F11打开VBA编辑器，在左侧工程栏右键点击当前工作簿，选择「插入」-「模块」，将上述代码粘贴到模块中
• 点击菜单栏「文件」-「另存为」，保存类型选择「Excel 加载宏(*.xlam)」，自定义文件名后按默认路径保存
• 回到Excel主界面，点击「开发工具」选项卡下的「Excel 加载项」，勾选你刚刚保存的加载项，点击确定后，所有打开的Excel文件都可以直接调用getData函数

函数使用说明 #

• 查询单个ID的单个字段：选中任意空白单元格，输入=getData(选中ID所在单元格, 选中列名所在单元格)按回车即可
• 查询多个ID的多个字段：选中和返回结果行列数一致的空白区域，输入=getData(选中所有要查询的ID单元格范围, 选中所有要查询的列名单元格范围)，如果是Excel 365/2021及以上版本直接回车即可，低版本Excel需要按Ctrl+Shift+Enter触发数组公式生效

注意事项 #

• 如果你的ID是纯数值类型，可以将代码中idStr = idStr & "'" & cell.Value & "'"里的单引号删除，避免查询匹配异常
• 如果数据源的工作表名、数据范围有调整，直接修改SQL语句里的[Sheet1$A1:Z500]部分即可
• 需提前确保系统ODBC数据源中SumitODBC的配置和你的数据源文件匹配

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