構建逗號分隔字符串

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