构建逗号分隔字符串答案

【问题标题】：Build a Comma Delimited String构建逗号分隔字符串
【发布时间】：2012-01-19 22:15:41
【问题描述】：

我想从 Range A1:A400 构建一个逗号分隔的字符串。

这样做的最佳方法是什么？我应该使用For 循环吗？

【问题讨论】：

可以使用 Chip Pearson 创建的 StringConcat 函数。请看下面的链接:) 主题：字符串连接 链接：http://www.cpearson.com/Excel/StringConcatenation.aspx

【解决方案1】：

最懒的方法是

s = join(Application.WorksheetFunction.Transpose([a1:a400]), ",")

这是因为多单元格范围的.Value 属性返回一个二维数组，而Join 需要一维数组，而Transpose 试图太有帮助，所以当它检测到只有一列的二维数组时，它将其转换为一维数组。

在生产中，建议使用至少少一点惰性选项，

s = join(Application.WorksheetFunction.Transpose(Worksheets(someIndex).Range("A1:A400").Value), ",")

否则将始终使用活动工作表。

【讨论】：

这是对我一直半理解的三种相当令人困惑的行为的简洁解释。我现在大约四分之三。
@GSerg 我如何为范围 A1 到 Z1 构建相同的字符串？
@user793468 好吧，如果你乐于保持懒惰，那就再换一个转置：join(Application.Worksheetfunction.Transpose(Application.WorksheetFunction.Transpose([a1:z1])), ",")
@GSerg 当我对列保持懒惰时，我收到类型不匹配错误。
请参阅下面的答案：我认为@GSerg 的这个答案是明确的答复 - 并且对 Transpose 中的一些奇怪之处进行了有用的解释 - 但是，为了完整起见，我发布了一个绕过 255- 的代码示例从单元格读取数据的字符限制。

【解决方案2】：

我认为@GSerg 的回答是对您问题的明确答复。

为了完整性 - 并解决其他答案中的一些限制 - 我建议您使用支持二维数组的“加入”函数：

s = Join2d(工作表(someIndex).Range("A1:A400").Value)

这里的重点是范围的 Value 属性（如果它不是单个单元格）始终是一个二维数组。

请注意，下面Join2d 函数中的行分隔符仅在有行（复数）要分隔时出现：您不会在单行范围的串联字符串中看到它。

Join2d：VBA 中的二维连接函数，具有优化的字符串处理

编码说明：

此Join 函数不受 255 个字符的限制，该限制会影响 Excel 中的大多数（如果不是全部）本机 Concatenate 函数，并且上面的 Range.Value 代码示例将完整地传递数据，来自包含较长字符串的单元格。
这是经过大量优化的：我们尽可能少地使用字符串连接，因为原生 VBA 字符串连接速度很慢，并且随着连接较长的字符串而逐渐变慢。

公共函数 Join2d(ByRef InputArray As Variant, _ 可选的 RowDelimiter As String = vbCr, _ 可选的 FieldDelimiter = vbTab,_ 可选 SkipBlankRows As Boolean = False) As String

' Join up a 2-dimensional array into a string. Works like VBA.Strings.Join, for a 2-dimensional array.
' Note that the default delimiters are those inserted into the string returned by ADODB.Recordset.GetString
On Error Resume Next

' Coding note: we're not doing any string-handling in VBA.Strings - allocating, deallocating and (especially!) concatenating are SLOW.
' We're using the VBA Join & Split functions ONLY. The VBA Join, Split, & Replace functions are linked directly to fast (by VBA standards)
' functions in the native Windows code. Feel free to optimise further by declaring and using the Kernel string functions if you want to.

' **** THIS CODE IS IN THE PUBLIC DOMAIN ****   Nigel Heffernan   Excellerando.Blogspot.com

Dim i As Long
Dim j As Long
Dim i_lBound As Long
Dim i_uBound As Long
Dim j_lBound As Long
Dim j_uBound As Long
Dim arrTemp1() As String
Dim arrTemp2() As String
Dim strBlankRow As String

i_lBound = LBound(InputArray, 1)
i_uBound = UBound(InputArray, 1)
j_lBound = LBound(InputArray, 2)
j_uBound = UBound(InputArray, 2)

ReDim arrTemp1(i_lBound To i_uBound)
ReDim arrTemp2(j_lBound To j_uBound)

For i = i_lBound To i_uBound

    For j = j_lBound To j_uBound
        arrTemp2(j) = InputArray(i, j)
    Next j
    arrTemp1(i) = Join(arrTemp2, FieldDelimiter)
Next i

If SkipBlankRows Then
    If Len(FieldDelimiter) = 1 Then
        strBlankRow = String(j_uBound - j_lBound, FieldDelimiter)
    Else
        For j = j_lBound To j_uBound
            strBlankRow = strBlankRow & FieldDelimiter
        Next j
    End If

    Join2d = Replace(Join(arrTemp1, RowDelimiter), strBlankRow & RowDelimiter, "")
    i = Len(strBlankRow & RowDelimiter)

    If Left(Join2d, i) = strBlankRow & RowDelimiter Then
        Mid$(Join2d, 1, i) = ""
    End If 
Else
    Join2d = Join(arrTemp1, RowDelimiter)
End If
Erase arrTemp1
End Function

为了完整起见，下面是对应的 2-D Split 函数：

Split2d：VBA 中的二维拆分函数，具有优化的字符串处理

Public Function Split2d(ByRef strInput As String, _ 
                        Optional RowDelimiter As String = vbCr, _ 
                        Optional FieldDelimiter = vbTab, _ 
                        Optional CoerceLowerBound As Long = 0) As Variant

' Split up a string into a 2-dimensional array. Works like VBA.Strings.Split, for a 2-dimensional array.
' Check your lower bounds on return: never assume that any array in VBA is zero-based, even if you've set Option Base 0
' If in doubt, coerce the lower bounds to 0 or 1 by setting CoerceLowerBound
' Note that the default delimiters are those inserted into the string returned by ADODB.Recordset.GetString
On Error Resume Next

' Coding note: we're not doing any string-handling in VBA.Strings - allocating, deallocating and (especially!) concatenating are SLOW.
' We're using the VBA Join & Split functions ONLY. The VBA Join, Split, & Replace functions are linked directly to fast (by VBA standards)
' functions in the native Windows code. Feel free to optimise further by declaring and using the Kernel string functions if you want to.


' **** THIS CODE IS IN THE PUBLIC DOMAIN ****   Nigel Heffernan  Excellerando.Blogspot.com

Dim i   As Long
Dim j   As Long
Dim i_n As Long
Dim j_n As Long
Dim i_lBound As Long
Dim i_uBound As Long
Dim j_lBound As Long
Dim j_uBound As Long
Dim arrTemp1 As Variant
Dim arrTemp2 As Variant

arrTemp1 = Split(strInput, RowDelimiter)

i_lBound = LBound(arrTemp1)
i_uBound = UBound(arrTemp1)

If VBA.LenB(arrTemp1(i_uBound)) <= 0 Then  ' clip out empty last row: common artifact data loaded from files with a terminating row delimiter
    i_uBound = i_uBound - 1
End If

i = i_lBound
arrTemp2 = Split(arrTemp1(i), FieldDelimiter)

j_lBound = LBound(arrTemp2)
j_uBound = UBound(arrTemp2)

If VBA.LenB(arrTemp2(j_uBound)) <= 0 Then  ' ! potential error: first row with an empty last field...
    j_uBound = j_uBound - 1
End If

i_n = CoerceLowerBound - i_lBound
j_n = CoerceLowerBound - j_lBound

ReDim arrData(i_lBound + i_n To i_uBound + i_n, j_lBound + j_n To j_uBound + j_n)

' As we've got the first row already... populate it here, and start the main loop from lbound+1

For j = j_lBound To j_uBound
    arrData(i_lBound + i_n, j + j_n) = arrTemp2(j)
Next j

For i = i_lBound + 1 To i_uBound Step 1
    arrTemp2 = Split(arrTemp1(i), FieldDelimiter)   
    For j = j_lBound To j_uBound Step 1    
        arrData(i + i_n, j + j_n) = arrTemp2(j)    
    Next j    
    Erase arrTemp2
Next i

Erase arrTemp1

Application.StatusBar = False

Split2d = arrData
End Function

分享和享受...并注意代码中不需要的换行符，由浏览器插入（或通过 StackOverflow 的有用格式化功能）

【讨论】：

+1 很棒的帖子！甚至在左边偷偷输入Mid$ 和LenB！唯一非常次要的挑剔建议是VbNullstring 而不是"" .... 所以我看到你是偶尔在迪克斯博客上发帖的 Nigel H。我喜欢你的工作
是我还是无法正确复制并粘贴到 vb 编辑器中？好的revision3 works复制和粘贴
所以不能用这个作为UDF？
Vijay - 您可以将其用作 UDF，但工作表上的数组函数有点脆弱。首先寻找本机 Excel 工作表功能。另外：我建议将“Application.Volatile False”放在任何用作 UDF 的函数头下方。

【解决方案3】：

您可以使用 Chip Pearson 创建的 StringConcat 函数。请看下面的链接:)

主题：字符串连接

链接：http://www.cpearson.com/Excel/StringConcatenation.aspx

引用链接以防链接失效

此页面描述了一个 VBA 函数，您可以使用它来连接数组公式中的字符串值。

StringConcat 函数

为了克服 CONCATENATE 函数的这些缺陷，有必要构建我们自己的用 VBA 编写的函数来解决 CONCATENATE 的问题。本页的其余部分描述了一个名为 StringConcat 的函数。这个函数克服了CONCATENATE的所有不足。它可用于连接单个字符串值、一个或多个工作表范围的值、文字数组以及数组公式运算的结果。

StringConcat的函数声明如下：

函数 StringConcat(Sep As String, ParamArray Args()) As String

Sep 参数是一个或多个字符，用于分隔要连接的字符串。这可能是 0 个或多个字符。 Sep 参数是必需的。如果您不想在结果字符串中使用任何分隔符，请使用空字符串作为 Sep 的值。Sep 值出现在要连接的每个字符串之间，但不会出现在结果字符串的开头或结尾。 ParamArray Args 参数是要连接的系列值。 ParamArray 中的每个元素都可以是以下任意一种：

文字字符串，例如“A” 由地址或范围名称指定的单元格范围。当二维范围的元素被连接时，连接的顺序是跨越一行然后向下到下一行。一个文字数组。例如，{"A","B","C"} 或 {"A";"B";"C"}

功能

Function StringConcat(Sep As String, ParamArray Args()) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' StringConcat
' By Chip Pearson, chip@cpearson.com, www.cpearson.com
'                  www.cpearson.com/Excel/stringconcatenation.aspx
' This function concatenates all the elements in the Args array,
' delimited by the Sep character, into a single string. This function
' can be used in an array formula. There is a VBA imposed limit that
' a string in a passed in array (e.g.,  calling this function from
' an array formula in a worksheet cell) must be less than 256 characters.
' See the comments at STRING TOO LONG HANDLING for details.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim S As String
Dim N As Long
Dim M As Long
Dim R As Range
Dim NumDims As Long
Dim LB As Long
Dim IsArrayAlloc As Boolean

'''''''''''''''''''''''''''''''''''''''''''
' If no parameters were passed in, return
' vbNullString.
'''''''''''''''''''''''''''''''''''''''''''
If UBound(Args) - LBound(Args) + 1 = 0 Then
    StringConcat = vbNullString
    Exit Function
End If

For N = LBound(Args) To UBound(Args)
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' Loop through the Args
    ''''''''''''''''''''''''''''''''''''''''''''''''
    If IsObject(Args(N)) = True Then
        '''''''''''''''''''''''''''''''''''''
        ' OBJECT
        ' If we have an object, ensure it
        ' it a Range. The Range object
        ' is the only type of object we'll
        ' work with. Anything else causes
        ' a #VALUE error.
        ''''''''''''''''''''''''''''''''''''
        If TypeOf Args(N) Is Excel.Range Then
            '''''''''''''''''''''''''''''''''''''''''
            ' If it is a Range, loop through the
            ' cells and create append the elements
            ' to the string S.
            '''''''''''''''''''''''''''''''''''''''''
            For Each R In Args(N).Cells
                If Len(R.Text) > 0 Then
                    S = S & R.Text & Sep
                End If
            Next R
        Else
            '''''''''''''''''''''''''''''''''
            ' Unsupported object type. Return
            ' a #VALUE error.
            '''''''''''''''''''''''''''''''''
            StringConcat = CVErr(xlErrValue)
            Exit Function
        End If
    
    ElseIf IsArray(Args(N)) = True Then
        '''''''''''''''''''''''''''''''''''''
        ' ARRAY
        ' If Args(N) is an array, ensure it
        ' is an allocated array.
        '''''''''''''''''''''''''''''''''''''
        IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
            (LBound(Args(N)) <= UBound(Args(N))))
        If IsArrayAlloc = True Then
            ''''''''''''''''''''''''''''''''''''
            ' The array is allocated. Determine
            ' the number of dimensions of the
            ' array.
            '''''''''''''''''''''''''''''''''''''
            NumDims = 1
            On Error Resume Next
            Err.Clear
            NumDims = 1
            Do Until Err.Number <> 0
                LB = LBound(Args(N), NumDims)
                If Err.Number = 0 Then
                    NumDims = NumDims + 1
                Else
                    NumDims = NumDims - 1
                End If
            Loop
            On Error GoTo 0
            Err.Clear
            ''''''''''''''''''''''''''''''''''
            ' The array must have either
            ' one or two dimensions. Greater
            ' that two caues a #VALUE error.
            ''''''''''''''''''''''''''''''''''
            If NumDims > 2 Then
                StringConcat = CVErr(xlErrValue)
                Exit Function
            End If
            If NumDims = 1 Then
                For M = LBound(Args(N)) To UBound(Args(N))
                    If Args(N)(M) <> vbNullString Then
                        S = S & Args(N)(M) & Sep
                    End If
                Next M
                
            Else
                ''''''''''''''''''''''''''''''''''''''''''''''''
                ' STRING TOO LONG HANDLING
                ' Here, the error handler must be set to either
                '   On Error GoTo ContinueLoop
                '   or
                '   On Error GoTo ErrH
                ' If you use ErrH, then any error, including
                ' a string too long error, will cause the function
                ' to return #VALUE and quit. If you use ContinueLoop,
                ' the problematic value is ignored and not included
                ' in the result, and the result is the concatenation
                ' of all non-error values in the input. This code is
                ' used in the case that an input string is longer than
                ' 255 characters.
                ''''''''''''''''''''''''''''''''''''''''''''''''
                On Error GoTo ContinueLoop
                'On Error GoTo ErrH
                Err.Clear
                For M = LBound(Args(N), 1) To UBound(Args(N), 1)
                    If Args(N)(M, 1) <> vbNullString Then
                        S = S & Args(N)(M, 1) & Sep
                    End If
                Next M
                Err.Clear
                M = LBound(Args(N), 2)
                If Err.Number = 0 Then
                    For M = LBound(Args(N), 2) To UBound(Args(N), 2)
                        If Args(N)(M, 2) <> vbNullString Then
                            S = S & Args(N)(M, 2) & Sep
                        End If
                    Next M
                End If
                On Error GoTo ErrH:
            End If
        Else
            If Args(N) <> vbNullString Then
                S = S & Args(N) & Sep
            End If
        End If
        Else
        On Error Resume Next
        If Args(N) <> vbNullString Then
            S = S & Args(N) & Sep
        End If
        On Error GoTo 0
    End If
ContinueLoop:
Next N

'''''''''''''''''''''''''''''
' Remove the trailing Sep
'''''''''''''''''''''''''''''
If Len(Sep) > 0 Then
    If Len(S) > 0 Then
        S = Left(S, Len(S) - Len(Sep))
    End If
End If

StringConcat = S
'''''''''''''''''''''''''''''
' Success. Get out.
'''''''''''''''''''''''''''''
Exit Function
ErrH:
'''''''''''''''''''''''''''''
' Error. Return #VALUE
'''''''''''''''''''''''''''''
StringConcat = CVErr(xlErrValue)
End Function

【讨论】：

我不愿意批评 Chip Pearson 编写的任何代码——他是公认的 VBA 和 Excel 开发艺术大师——但这不是你在 VBA 中进行字符串连接的方式。基本技术是避免分配和连接（原因如下：aivosto.com/vbtips/stringopt2.html#huge）——我为此使用了 join、split 和 replace——更高级的技术列在本文的第一、二和二部分：aivosto.com/vbtips/stringopt3.html
另外... Concatenate 函数受到从包含超过 255 个字符的单元格中读取数据的熟悉限制的限制。请参阅下面的代码示例，带有二维“加入”功能。