0

请帮我在 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”不起作用请你帮我解决这个问题。非常感谢

4

1 回答 1

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 测试并且工作正常。

于 2013-08-02T06:43:41.997 回答