构建逗号分隔字符串

Question

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

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

Answer 1

最懒的办法是

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

这工作，因为多小区范围内的.Value属性返回一个二维数组，并Join预计一维数组，Transpose正试图太有帮助的，所以当它检测到2D只有一列的数组，它将其转换为一维数组。

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

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

否则将始终使用的活性片。

Answer 2

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

主题：万一http://www.cpearson.com/Excel/StringConcatenation.aspx

报价从链接的链接永远不会消逝的

本页面：字符串连接

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

的StringConcat功能

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

StringConcat的函数声明如下：

功能StringConcat（九月，作为字符串的ParamArray参数数量（））作为字符串

在SEP参数是一个字符或分隔字符串被级联字符。这可能是0个或更多字符。 Sep参数是必需的。如果您不希望结果字符串中有任何分隔符，请为Sep的值使用空字符串。Sep值会出现在每个要连接的字符串之间，但不会出现在结果字符串的开头或结尾。 ParamArray参数是一系列要连接的值。 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 

Answer 3

我会认为@ GSerg的回答为你问题的最终答复。

为了完整 - 并解决其他的答案有一些限制 - 我建议你使用支持2维数组一个“加入”功能：

 
s = Join2d(Worksheets(someIndex).Range("A1:A400").Value) 

这里的要点是，范围的值属性（提供它不是单个单元格）始终是一个二维数组。

请注意，下面的Join2d函数中的行分隔符仅在存在行（复数）分隔时才存在：您不会在单行范围的连接字符串中看到它。

Join2d：2维加入功能在VBA与优化的字符串处理

编码笔记：

1. 这Join功能不会影响大多数255字符限制的影响（如果不是所有）Excel中的本地连接函数，上面的Range.Value代码示例将从包含更长字符串的单元格中全部传入数据。
2. 这是经过严格优化的：我们尽可能少地使用字符串连接，因为本地VBA字符串连接速度较慢，并且随着连接较长的字符串而逐渐变慢。

 
    Public Function Join2d(ByRef InputArray As Variant, _ 
          Optional RowDelimiter As String = vbCr, _ 
          Optional FieldDelimiter = vbTab,_ 
          Optional 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 2维Split函数具有优化的字符串处理

 

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的乐于助人的格式化功能）插入