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
