Question

请帮我在excel vba中创建用户定义的函数示例

Function GetTheValue(wbPath, wbName, wsName, cellRef)
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim tmp As Range
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & wbPath & wbName & ";" & _
      "Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
    rst.Open "SELECT * FROM [" & wsName & "$" & cellRef & "]", cnn
    Set tmp = Range("L5")
    tmp.CopyFromRecordset rst
    MsgBox tmp.Value
    GetTheValue = tmp.Value
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Function

我尝试通过签署公式

在单元格中使用它

=GetThaValue("D:\";"test.xls";"Sheet1";"B4")

并看到我的代码的字符串“tmp.CopyFromRecordset rst”不起作用请你帮我解决这个问题。非常感谢

Answer 1

如果要从任何Excel单元调用此函数，则需要进行一些更改。

首先 - 我做了一些测试，似乎不允许在SQL语句中指向单个单元格，因此需要以这种方式调用您的函数：

=GetThaValue("D:\";"test.xls";"Sheet1";"B4:B5")

其中第一个单元格B4将是您搜索的单元格。

第二 - 该功能略有改进，内部注释如下：

Function GetTheValue(wbPath, wbName, wsName, cellRef)
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim tmp As Range
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset

    'some changes here according to www.ConnectionStrings.Com
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
          "Data Source=" & wbPath & wbName & ";" & _
          "Extended Properties=""Excel 8.0;"""

    rst.Open "SELECT * FROM [" & wsName & "$" & cellRef & "]", cnn

    'Set tmp = Range("L5")      'NOT needed here
    'tmp.CopyFromRecordset rst   'NOT allowed if function is called from Excel
    'MsgBox tmp.Value           'NOT necessary in this function

    'NEW- in this way we get value of your cell and pass it to excel
    GetTheValue = rst.Fields(0).Value

    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Function

我可以确认它已经过Excel 2010测试，并且运行正常。

如何使用ADO连接进行用户定义的功能

1 个答案: