Construya una Cadena Delimitada

Question

Quiero construir una cadena delimitada por comas del Rango A1:A400.

¿Cuál es la mejor manera de hacerlo? ¿Debo usar un loop For?

Answer 1

La forma más perezosa es

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

Esto funciona porque .Value propiedad de un rango multicelular devuelve una matriz 2D, y Join espera matriz 1D y Transpose está tratando de ser demasiado útil, por lo que cuando se detecta un 2D array con solo una columna, lo convierte en una matriz 1D.

En la producción que se aconseja utilizar la opción de, al menos, un poco menos vago,

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

de lo contrario siempre se utilizará la hoja activa.

Answer 2

Puede usar la función StringConcat creada por Chip Pearson. Por favor, vea el siguiente enlace :)

Tema: Concatenación de

Enlace: http://www.cpearson.com/Excel/StringConcatenation.aspx

cita del enlace en caso de que el enlace nunca muere

Esta página describe una función de VBA que puede usar para concatenar valores de cadena en una fórmula de matriz.

La Función StringConcat

Con el fin de superar estas deficiencias de la función concatenar, es necesaria la construcción de nuestra propia función escrita en VBA que se ocupará de los problemas de concatenar. El resto de esta página describe una función como StringConcat. Esta función supera todas las deficiencias de CONCATENATO. Se puede utilizar para concatenar valores de cadena individuales, los valores de uno o más rangos de hojas de trabajo, matrices literales y los resultados de una operación de fórmula de matriz.

La declaración de la función de StringConcat es el siguiente:

Función StringConcat (sep como secuencia, Args ParamArray()) como secuencia

El parámetro SEP es un carácter o caracteres que separan las cadenas estar concatenados. Esto puede ser 0 o más caracteres. El parámetro Sep es obligatorio. Si no desea ningún separador en la cadena resultante, use una cadena vacía para el valor de Sep. El valor Sep aparece entre cada cadena que se concatena, pero no aparece al comienzo o al final de la cadena de resultados. El parámetro ParamArray Args es un valor de serie que se concatenará. Cada elemento en ParamArray puede ser cualquiera de los siguientes:

Una cadena literal, como "A" Un rango de celdas, especificado por dirección o por un Nombre de rango. Cuando se concatenan elementos de un rango bidimensional, el orden de concatenación se encuentra en una fila y luego en la siguiente fila. Una matriz literal.Por ejemplo, { "A", "B", "C"} o { "A"; "B", "C"}

La función

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

yo consideraría @ GSerg de responde como la respuesta definitiva a tu pregunta.

Para completar - y para hacer frente a algunas limitaciones en otras respuestas - Yo sugeriría que se utiliza una función 'Join' que da soporte a matrices de 2 dimensiones:

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

El punto aquí es que la La propiedad de valor de un rango (siempre que no sea una sola célula) siempre es una matriz bidimensional.

Tenga en cuenta que el delimitador de filas en la función Join2d a continuación solo está presente cuando hay Filas (plurales) para delimitar: no lo verá en la cadena concatenada de un rango de una sola fila.

Join2d: A 2-dimensional función de Ingreso en VBA con la cadena de manipulación de

notas de codificación optimizados:

1. Esta función Join no sufre de la limitación 255-char que afecta a la mayoría (si no se todas) de las funciones Concatenadas nativas en Excel, y el ejemplo del código Range.Value arriba pasará los datos, completos, de las celdas que contienen cadenas más largas.
2. Esto está muy optimizado: utilizamos la concatenación de cadenas lo menos posible, ya que las concatenaciones de cadenas VBA nativas son lentas y progresivamente más lentas a medida que se concatena una cadena más larga.

 
    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 
 

Para completar, aquí está la correspondiente función Split 2-D:

Split2d: Una función Split de 2 dimensiones en VBA con una optimización de la cadena de manipulación de

 

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 
 

Compartir y disfrutar ... Y cuidado con las pausas no deseadas de línea en el código, insertadas por su navegador (o por funciones de formato de votos StackOverflow)