UDF 返回的数组对于调用范围来说太大或太小

Question

以下函数将数组返回到工作表。 我标记一个区域，键入我的函数，然后按 Ctrl+Shift+Enter 以使单元格填充有记录集中的数据。

但如果 CSE 函数的选定区域大于返回的记录集，我会收到 #N/A。如果它更小，则不会显示警告。

是否有一种简单的方法可以将#N/A 替换为"" 值，并且如果数组函数的范围小于返回的数组 - 显示警告？

这是我当前的工作函数，它从记录集中返回一个数组：

Function SQL(dataRange As Range, CritA As String, CritB As Double) As Variant

Application.Volatile

        Dim cn As ADODB.Connection
        Dim rs As ADODB.Recordset
        Dim currAddress As String
        Dim varHdr, varDat, varOut As Variant
        Dim nc, nr, i, j As Long

        SQL = Null

        currAddress = ActiveSheet.Name & "$" & dataRange.Address(False, False)

        strFile = ThisWorkbook.FullName
        strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
        & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=0"";"

        Set cn = CreateObject("ADODB.Connection")
        Set rs = CreateObject("ADODB.Recordset")

        rs.CursorLocation = adUseClient ' required to return the number of rows correctly
        cn.Open strCon

        strSQL = "SELECT * FROM [" & currAddress & "]" & _
                 "WHERE [A] =  '" & CritA & "' AND [B] >= " & CritB & " " & _
                 "ORDER BY 10 DESC"

        rs.Open strSQL, cn

        ' Process Column Headings
        nc = rs.Fields.Count
        ReDim varHdr(nc - 1, 0)
        For i = 0 To rs.Fields.Count - 1
            varHdr(i, 0) = rs.Fields(i).Name
        Next

        ' Get Rows from the Recordset
        nr = rs.RecordCount
        varDat = rs.GetRows

        ' Combing Header and Data and Transpose

        ReDim varOut(0 To nr, 0 To nc - 1)
        For i = 0 To nc - 1
            varOut(0, i) = varHdr(i, 0)
        Next




        For i = 1 To nr
            For j = 0 To nc - 1
               varOut(i, j) = varDat(j, i - 1)



            Next
        Next

      ' Optional alternative - write Output Array to Sheet2
      '  With Sheet2
      '      .Cells.Clear
      '      .Range("A1").Resize(nr, nc) = varOut
      '  End With

          SQL = varOut


        Erase varOut
        Erase varHdr
        Erase varDat

        rs.Close
        Set rs = Nothing
        Set cn = Nothing
End Function

Answer 1

如果您的输出数组小于调用范围，您可以使用"" 填充输出数组的未使用部分。

如果调用范围太小，你可以显示一个消息框，或者返回一个Excel错误值，或者……看你想要什么。

如何做这些事情的例子。

Function test()

    'Get interesting content
    Dim contentOut As Variant
    contentOut = [{1,2;3,4}] ' or a database connection, or whatever

    'Figure out size of calling range which will receive the output array
    Dim nRow As Long: nRow = Application.Caller.Rows.Count
    Dim nCol As Long: nCol = Application.Caller.Columns.Count

    'Error if calling range too small
    If nRow < UBound(contentOut, 1) Or nCol < UBound(contentOut, 2) Then
        'Popup message
        MsgBox "your range is too small."
        ' or return #VALUE! error
        test = CVErr(xlValue)
        ' or both or whatever else you want there to happen
        Exit Function
    End If

    'Initialise output array to match size of calling range
    Dim varOut As Variant
    ReDim varOut(1 To nRow, 1 To nCol)
    'And fill it with some background value
    Dim iRow As Long
    Dim iCol As Long
    For iRow = 1 To nRow
        For iCol = 1 To nCol
            varOut(iRow, iCol) = "" ' or "funny bear", or whatever
        Next
    Next

    'Put content in output array and return
    For iRow = 1 To UBound(contentOut, 1)
        For iCol = 1 To UBound(contentOut, 2)
            varOut(iRow, iCol) = contentOut(iRow, iCol)
        Next
    Next
    test = varOut
End Function

Answer 2

非常感谢 Jean 的回答，并将我欠帮助我的人的完整代码粘贴到这里！我只对数组进行了小幅转换，以便显示标题和最后一列。

Function SQL(dataRange As Range, CritA As String, CritB As Double) As Variant
    Application.Volatile

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim currAddress As String
    Dim varHdr, varDat, contentOut As Variant
    Dim nc, nr, i, j As Long

    SQL = Null

    currAddress = ActiveSheet.Name & "$" & dataRange.Address(False, False)

    strFile = ThisWorkbook.FullName
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=0"";"

    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    rs.CursorLocation = adUseClient ' required to return the number of rows correctly
    cn.Open strCon

    strSQL = "SELECT * FROM [" & currAddress & "]" & _
             "WHERE [A] =  '" & CritA & "' AND [B] >= " & CritB & " " & _
             "ORDER BY 10 DESC"

    rs.Open strSQL, cn

    ' Process Column Headings
    nc = rs.Fields.Count
    ReDim varHdr(nc - 1, 0)
    For i = 0 To rs.Fields.Count - 1
        varHdr(i, 0) = rs.Fields(i).Name
    Next

    ' Get Rows from the Recordset
    nr = rs.RecordCount
    varDat = rs.GetRows

    ' Combing Header and Data and Transpose

    ReDim contentOut(0 To nr, 0 To nc - 1)
    For i = 0 To nc - 1
        contentOut(0, i) = varHdr(i, 0)
    Next




    For i = 1 To nr
        For j = 0 To nc - 1
           contentOut(i, j) = varDat(j, i - 1)



        Next
    Next

  ' Optional solution: Write Output Array to Sheet2
  '  With Sheet2
  '      .Cells.Clear
  '      .Range("A1").Resize(nr, nc) = contentOut
  '  End With


    'Figure out size of calling range which will receive the output array
    Dim nRow As Long: nRow = Application.Caller.Rows.Count
    Dim nCol As Long: nCol = Application.Caller.Columns.Count

    'Error if calling range too small
    If nRow < UBound(contentOut, 1) Or nCol < UBound(contentOut, 2) Then
        'Popup message
        'MsgBox "your range is too small."
        ' or return #VALUE! error
        SQL = "Too small range" 'CVErr(xlValue)
        ' or both or whatever else you want there to happen
        Exit Function
    End If

    'Initialise output array to match size of calling range
    Dim varOut As Variant
    ReDim varOut(1 To nRow, 1 To nCol)
    'And fill it with some background value
    Dim iRow As Long
    Dim iCol As Long
    For iRow = 1 To nRow

        For iCol = 1 To nCol
            varOut(iRow, iCol) = ""   ' or "funny bear", or whatever
        Next
    Next

    'Put content in output array and return
    For iRow = 0 To UBound(contentOut, 1)
        For iCol = 0 To UBound(contentOut, 2)
            varOut(iRow + 1, iCol + 1) = contentOut(iRow, iCol)
        Next
    Next



      SQL = varOut

    'Cleanup
    Erase contentOut
    Erase varHdr
    Erase varDat

    rs.Close
    Set rs = Nothing
    Set cn = Nothing


End Function