vba 建立一个逗号分隔的字符串
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/8934184/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Build a Comma Delimited String
提问by user793468
I want to build a comma delimited string from Range A1:A400.
我想从 Range 构建一个逗号分隔的字符串A1:A400。
What is the best way of doing this? Should I use a Forloop?
这样做的最佳方法是什么？我应该使用For循环吗？
回答by GSerg
The laziest way is
最懒的方法是
s = join(Application.WorksheetFunction.Transpose([a1:a400]), ",")
This works because .Valueproperty of a multicell range returns a 2D array, and Joinexpects 1D array, and Transposeis trying to be too helpful, so when it detects a 2D array with just one column, it converts it to a 1D array.
这是有效的，因为.Value多单元格范围的属性返回一个二维数组，并Join期望一维数组，并且Transpose试图提供太多帮助，因此当它检测到只有一列的二维数组时，它会将其转换为一维数组。
In production it is advised to use at least a little bit less lazy option,
在生产中，建议至少使用少一点懒惰的选项，
s = join(Application.WorksheetFunction.Transpose(Worksheets(someIndex).Range("A1:A400").Value), ",")
otherwise the active sheet will always be used.
否则将始终使用活动工作表。
回答by Nigel Heffernan
I would regard @GSerg's answer as the definitive reply to your question.
我会将@GSerg 的回答视为对您问题的明确答复。
For completeness - and to address a few limitations in other answers - I would suggest that you use a 'Join' function that supports 2-Dimensional arrays:
为了完整性 - 并解决其他答案中的一些限制 - 我建议您使用支持二维数组的“加入”函数：
s = Join2d(Worksheets(someIndex).Range("A1:A400").Value)
The point here is that the Value property of a range (providing it isn't a single cell) is always a 2-Dimensional array.
这里的要点是范围的 Value 属性（假设它不是单个单元格）始终是一个二维数组。
Note that the row delimiter in the Join2dfunction below is only present when there are Rows (plural) to delimit: you won't see it in the concatenated string from a single-row range.
请注意，Join2d下面函数中的行分隔符仅在有要分隔的行（复数）时才存在：您不会在单行范围的连接字符串中看到它。
Join2d: A 2-Dimensional Join function in VBA with optimised string-handling
Join2d：VBA 中具有优化字符串处理的二维连接函数
Coding notes:
编码说明：
- This
Joinfunction does not suffer from the 255-char limitation that affects most (if not all) of the native Concatenate functions in Excel, and the Range.Value code sample above will pass in the data, in full, from cells containing longer strings. - This is heavily optimised: we use string-concatenation as little as possible, as the native VBA string-concatenations are slow and get progressively slower as a longer string is concatenated.
- 此
Join函数不受 255 字符限制的影响，该限制会影响 Excel 中的大多数（如果不是全部）本机 Concatenate 函数，并且上面的 Range.Value 代码示例将从包含更长字符串的单元格中完整地传递数据。 - 这是经过大量优化的：我们尽可能少地使用字符串连接，因为原生 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
For completeness, here's the corresponding 2-D Split function:
为了完整起见，这里是相应的 2-D Split 函数：
Split2d: A 2-Dimensional Split function in VBA with optimised string-handling
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
Share and enjoy... And watch out for unwanted line breaks in the code, inserted by your browser (or by StackOverflow's helpful formatting functions)
分享和享受......并注意代码中不需要的换行符，由您的浏览器（或 StackOverflow 的有用格式功能）插入
回答by Siddharth Rout
You can use the StringConcat Function created by Chip Pearson. Please see the below link :)
您可以使用 Chip Pearson 创建的 StringConcat 函数。请看下面的链接:)
Topic: String Concatenation
主题：字符串连接
Link: http://www.cpearson.com/Excel/StringConcatenation.aspx
链接：http: //www.cpearson.com/Excel/StringConcatenation.aspx
Quote From the link in case the link ever dies
引用链接以防链接失效
This page describes a VBA Function that you can use to concatenate string values in an array formula.
The StringConcat Function
In order to overcome these deficiencies of the CONCATENATE function, it is necessary to build our own function written in VBA that will address the problems of CONCATENATE. The rest of this page describes such a function named StringConcat. This function overcomes all of the deficiencies of CONCATENATE. It can be used to concatenate individual string values, the values one or more worksheet ranges, literal arrays, and the results of an array formula operation.
The function declaration of StringConcat is as follows:
Function StringConcat(Sep As String, ParamArray Args()) As String
The Sep parameter is a character or characters that separate the strings being concatenated. This may be 0 or more characters. The Sep parameter is required. If you do not want any separators in the result string, use an empty string for the value of Sep. The Sep value appears between each string being concatenated, but does not appear at either the beginning or end of the result string. The ParamArray Args parameter is a series values to be concatenated. Each element in the ParamArray may be any of the following:
A literal string, such as "A" A range of cells, specified either by address or by a Range Name. When elements of a two dimensional range are concatenated, the order of concatenation is across one row then down to the next row. A literal array. For example, {"A","B","C"} or {"A";"B";"C"}
The function
本页介绍了可用于连接数组公式中的字符串值的 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, [email protected], 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
