Excel VBA UDF для объединения дает сообщение об ошибке

Question

Я пытаюсь написать пользовательскую функцию (UDF) в Excel, которая будет принимать значения в диапазоне ячеек и объединять их определенным образом. В частности, я хочу объединить их таким образом, чтобы результирующая строка могла быть вставлена ​​в функцию 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

Answer 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

Answer 2

Немного другой подход, который позволяет вам указывать запятую (это будет запятая, если вы не укажете). Можно добавить еще один аргумент для другого.

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

Answer 3

Это работает для меня (не стесняйтесь добавлять в ваши сообщения об ошибках и т. Д.):

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