用于连接的 Excel VBA UDF 给出错误消息答案

【问题标题】：Excel VBA UDF for concatenating is giving an Error message用于连接的 Excel VBA UDF 给出错误消息
【发布时间】：2017-03-24 16:32:55
【问题描述】：

我正在尝试在 Excel 中编写一个用户定义函数 (UDF)，它将获取一系列单元格中的值，并以某种方式连接它们。具体来说，我想以一种可以将结果字符串粘贴到 SQL“in”函数中的方式连接它们 - 即，如果我在 Excel 中有一个包含以下内容的范围：

apples
oranges
pears

我希望 UDF 生成 'apples', 'oranges', 'pears'

（即最后一个值后面没有逗号）。

这是我的代码 - 它在 VBA 窗口中编译正常，但是当我在工作表中使用它时，我得到了错误。任何想法都非常感谢 - 我在编写 VBA 方面有点新手。并为这个模糊的问题道歉；我只是不知道是哪一点引起了麻烦。

Function ConcatenateforSQL(ConcatenateRange As Range) As Variant     



    Dim i As Long

    Dim strResult1 As String
    Dim strResult2 As String

    Dim Separator1 As String
    Dim Separator2 As String


    Separator1 = "'"  'hopefully the quotes act as escape characters
    Separator2 = "',"



    On Error GoTo ErrHandler



    For i = 1 To CriteriaRange.Count - 1                                              'all but the last one
              strResult1 = strResult1 & Separator1 & ConcatenateRange.Cells(i).Value & Separator2

    Next i


    'next, sort out the last example in the string

    For i = CriteriaRange.Count - 0 To CriteriaRange.Count + 0

      strResult2 = strResult1 & Separator1 & ConcatenateRange.Cells(i).Value & Separator1

    Next i


    ConcatenateforSQL = strResult2  

    Exit Function

ErrHandler:
    ConcatenateforSQL = CVErr(xlErrValue)
End Function

【问题讨论】：

您还没有定义CriteriaRange。也许应该读为“ConcatenateRange”？
另外值得记住的是，如果您想将其用作工作簿中的工作表函数，则它需要位于 Module 而不是 Worksheet 代码对象中。
哦，好旗帜，SJR - 我以为我已经改变了所有这些，但显然没有！
@Dave - 它在一个模块中 - 也许我在这里粘贴的方式不清楚？还是我可能错过了什么？它是 VBA 编辑器中的 Module1。
@s.turn 不，您几乎没有遗漏任何东西-您没有提到它在模块中，所以我认为值得一提..

标签： vba excel udf

【解决方案1】：

我更喜欢 JOIN 数组方法。

Option Explicit

Function ConcatenateforSQL(ConcatenateRange As Range) As Variant
    On Error GoTo ErrHandler

    Dim r As Long, c As Long
    Dim vVAL As Variant, vVALS As Variant

    ReDim vVAL(1 To 1)
    vVALS = ConcatenateRange.Value2

    For r = LBound(vVALS, 1) To UBound(vVALS, 1)
        For c = LBound(vVALS, 2) To UBound(vVALS, 2)
            'Debug.Print vVALS(r, c)
            ReDim Preserve vVAL(1 To (r * c))
            vVAL(r * c) = vVALS(r, c)
        Next c
    Next r

    ConcatenateforSQL = Chr(39) & Join(vVAL, "','") & Chr(39)
    Exit Function

ErrHandler:
    ConcatenateforSQL = CVErr(xlErrValue)
End Function

【讨论】：

【解决方案2】：

这对我有用（请随意添加您的错误陷阱等）：

Function ConcatenateforSQL(ConcatenateRange As Range) As Variant
Dim csql As String
csql = ""
For Each cl In ConcatenateRange
    If Len(cl) > 0 Then
        If csql <> "" Then csql = csql & ","
        csql = csql & "'" & cl.Value & "'"
    End If
Next
ConcatenateforSQL = csql
End Function

【讨论】：

谢谢，CLR - 令人尴尬的是，解决方案只是使用查找和替换来更新我不小心留下未更正的引用！不过，我也会研究你的版本，因为它看起来比我的更优雅。再次感谢:-)
Join 方法很好，但意味着您可以获得空白。我的方法跳过了空白单元格。我自己安装的插件版本（我每天都用它来做同样的事情）的另一件事是跳过行高为零的单元格（即隐藏或过滤），这也是一个非常方便的功能。跨度>

【解决方案3】：

一种稍微不同的方法，允许您指定逗号分隔符（如果您不指定，它将是一个逗号）。一个人可以为另一个人添加一个进一步的论据。

Function ConcatenateforSQL(ConcatenateRange As Range, Optional sSep As String = ",") As Variant

Dim i As Long

Dim strResult As String

On Error GoTo ErrHandler

For i = 1 To ConcatenateRange.Count
    strResult = strResult & sSep & "'" & ConcatenateRange.Cells(i).Value & "'"
Next i

ConcatenateforSQL = Mid(strResult, Len(sSep) + 1)

Exit Function

ErrHandler:
ConcatenateforSQL = CVErr(xlErrValue)

End Function

【讨论】：