我试图在Excel中编写用户定义函数(UDF),它将获取一系列单元格中的值,并以某种方式连接它们。具体来说,我希望以一种方式将它们连接起来,即生成的字符串可以粘贴到SQL" in"函数 - 即如果我在Excel中有一个范围包含:
apples
oranges
pears
我希望UDF产生'apples', 'oranges', 'pears'
(即最后一个值后没有逗号)。
这是我的代码 - 它在VBA窗口中编译好,但是当我在工作表中使用它时,我只是得到了ERROR。任何想法都非常感激 - 我在写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
答案 0 :(得分:2)
我更喜欢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
答案 1 :(得分:1)
这对我有用(随意添加错误陷阱等):
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
答案 2 :(得分:1)
一种稍微不同的方法,允许您指定逗号分隔符(如果您未指定,则为逗号)。可以为另一个添加另一个论点。
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