Funcion Concatenado

Funcion Concatenado

Función Concatenado

Dos procedimientos, uno de los cuales repite un bucle tantas veces como celdas tengamos a unir o concatenar:

  • Procedimiento de Repetición de Bucle
  • Procedimiento de una sola pasada

1 Repeticion de Bucle

Function ConcatenarCeldas(Celdas As Range, _
Optional Separa As String = " ") As String
Dim Celda As Range, Final As String
For Each Celda In Celdas
Final = Final & IIf(Len(Final), Separa, "") & Celda
Next: ConcatenarCeldas = Final: End Function

2 Otro procedimiento con la misma función pero..... haciendo una sola pasada

   
    Function Concatenado(Datos As Range, _
    Optional xColumnas As Boolean = False, _
    Optional Separa As String = " ") As String
    With Application: Concatenado = Join(IIf(xColumnas, _
    .Transpose(.Transpose(Datos)), .Transpose(Datos)), Separa): End With: End Function 

Se tiene queindicar si el rango es vertical… (p.e. B5:B50) o la concatenación sera por filas en una columna (p.e.B5:Q5) usando el argumento xColumnas (opcional y por omisión falso) y si se piensa utilizar en xl-97 (VBA5) que no tiene la función Join(obviamente) habría que proveerla usando compilación de VBA6 y esta seria la estructura del código (AL INICIO DE UN MODULO) - Compilación para XL-97

Compilación para XL-97

Option Private Module
#If Not VBA6 Then
Function Replace(ByVal Texto As String, Busca As String, Reemplaza As String) As Variant
  Replace = Application.Substitute(Texto, Busca, Reemplaza): End Function
Function Split(Cadena As String, Delimitador As String) As Variant
  Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}"): End Function
Function Join(Matriz, Optional Separa As String) As String
  Dim Texto As String, Sig As Integer: On Error GoTo Join_error
  If VarType(Matriz) >= vbArray Then
    Texto = Matriz(LBound(Matriz))
    If UBound(Matriz) Then
      For Sig = LBound(Matriz) + 1 To UBound(Matriz)
        Texto = Texto & IIf(Len(Separa), Separa, "") & Matriz(Sig)
      Next: End If: Join = Texto
  Else: Join = CStr(Matriz)
  End If: Exit Function
Join_error:
  If Err.Number <> 0 Then Join = Err.Description
End Function
#End If

Print