Build a Comma Delimited String

后端 未结 3 1481
迷失自我
迷失自我 2020-12-01 19:27

I want to build a comma delimited string from Range A1:A400.

What is the best way of doing this? Should I use a For loop?

相关标签:
3条回答
  • 2020-12-01 20:04

    You can use the StringConcat Function created by Chip Pearson. Please see the below link :)

    Topic: String Concatenation

    Link: 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

    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
    
    0 讨论(0)
  • 2020-12-01 20:05

    The laziest way is

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

    This works because .Value property of a multicell range returns a 2D array, and Join expects 1D array, and Transpose is trying to be too helpful, so when it detects a 2D array with just one column, it converts it to a 1D array.

    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.

    0 讨论(0)
  • 2020-12-01 20:16

    I would regard @GSerg's answer as the definitive reply to your question.

    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.

    Note that the row delimiter in the Join2d function 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: A 2-Dimensional Join function in VBA with optimised string-handling

    Coding notes:

    1. This Join function 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.
    2. 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.
        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:

    Split2d: A 2-Dimensional Split function in VBA with optimised string-handling

    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)

    0 讨论(0)
提交回复
热议问题