我想从Range A1:A400
构建一个逗号分隔的字符串。
这样做的最佳方式是什么?我应该使用For
循环吗?
答案 0 :(得分:17)
最懒惰的方式是
s = join(Application.WorksheetFunction.Transpose([a1:a400]), ",")
这是有效的,因为多单元格范围的.Value
属性返回一个二维数组,而Join
需要一维数组,Transpose
试图太有用,所以当它检测到一个二维数组时只有一列的数组,它将它转换为一维数组。
在制作中,建议使用至少少一点懒惰的选项,
s = join(Application.WorksheetFunction.Transpose(Worksheets(someIndex).Range("A1:A400").Value), ",")
否则将始终使用活动表。
答案 1 :(得分:4)
我认为@ GSerg的答案是对你问题的最终答复。
为了完整性 - 并解决其他答案中的一些限制 - 我建议您使用支持二维数组的“连接”功能:
s = Join2d(Worksheets(someIndex).Range("A1:A400").Value)
这里的要点是范围的Value属性(假设它不是单个单元格)始终是一个二维数组。
请注意,以下Join2d
函数中的行分隔符仅在存在要分隔的行(复数)时出现:您不会在单行范围的连接字符串中看到它。
Join2d:VBA中的二维连接函数,具有优化的字符串处理
编码说明:
Join
函数不会受到影响Excel中大多数(如果不是全部)原生Concatenate函数的255-char限制,并且上面的Range.Value代码示例将传入数据,来自包含更长字符串的单元格。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
为了完整性,这里是相应的二维分割功能:
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有用的格式化功能)
答案 2 :(得分:1)
您可以使用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中的每个元素可以是以下任何一个:
一个文字字符串,例如&#34; A&#34; 一系列单元格,由地址或范围名称指定。当连接二维范围的元素时,连接的顺序跨越一行然后向下到下一行。 文字数组。例如,{&#34; A&#34;,&#34; B&#34;,&#34; C&#34;}或{&#34; A&#34 ;;&#34; B&#34; ;&#34; C&#34;}
功能
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