Función para unir registros de varias filas

He visto una función muy interesante para unir registros de varias filas en:

Unir registros de varias filas en un solo campo si coincide la referencia

¿Sería muy difícil hacer una más genérica, dependiendo del campo de referencia y del campo que hay que agrupar?

Respuesta
1

¿Exactamente qué necesitas?.

Concatenar campos es sencillo, se trata de juntar en un único resultado (una variable por ejemplo) los datos de un mismo campo de un recordset (que puede ser una tabla o consulta y que puede tener o no tener condiciones).

Por ejemplo una función que permita agrupar por el campo y contar los que se repiten.

Se le indica el campo a agrupar, la tabla a la que pertenece y admite una condicion a cumplir:

Public Function Concatena(Una_Tabla As String, Un_Campo As String, Una_Condicion As String) As String
Dim Tem_Recordset As DAO.Recordset, Temp_Sql As String, Actual As String, Cuenta As Long
Temp_Sql = "Select " & Un_Campo & " from " & Una_Tabla
If Una_Condicion <> "" Then Temp_Sql = Temp_Sql & " Where " & Una_Condicion
Temp_Sql = Temp_Sql & " order by " & Un_Campo
Set Tem_Recordset = CurrentDb.OpenRecordset(Temp_Sql, , dbReadOnly)
If Tem_Recordset.RecordCount = 0 Then Exit Function
With Tem_Recordset
.MoveLast: .MoveFirst
Actual = .Fields(0)
Do Until .EOF
If Actual <> .Fields(0) Then
If Len(Concatena) <> 0 Then Concatena = Concatena & ", "
Concatena = Concatena & .Fields(0) & "= " & Cuenta
Actual = .Fields(0)
Cuenta = 0
End If
Cuenta = Cuenta + 1
.MoveNext
Loop
.Close
End With
Set Tem_Recordset = Nothing
End Function

Devuelve en una línea y separados por comas, el valor del campo y la cuenta de sus repeticiones
Se puede modificar para crear una tabla que devuelve en un campo el dato y en otro la cuenta de sus repeticiones .

Para Eduardo Pérez Fernández:

Ni da error al compilar ni da error al ejecutarse.

Revise su aplicación (por si se repite en nombre de la función) y no le vendría nada mal aprender a programar (no se conforme con imitar) así podría juzgar con conocimiento y si hay un error delatarlo.

1 respuesta más de otro experto

Respuesta

Leopoldo efectivamente esa respuesta es de mi autoría. Pruebe con esta función pasándole los respectivos parámetros.

Function UnirRegistros(tabla As String, campoReferencia As String, campoAgrupar As String) As String
    Dim rs As Recordset
    Dim sql As String
    Dim resultado As String
    ' Crear una consulta SQL para obtener los registros a unir
    sql = "SELECT " & campoAgrupar & " FROM " & tabla & " GROUP BY " & campoReferencia
    ' Ejecutar la consulta y abrir el recordset
    Set rs = CurrentDb.OpenRecordset(sql)
    ' Recorrer el recordset y concatenar los valores en una cadena
    Do Until rs.EOF
        resultado = resultado & rs(campoAgrupar) & ", "
        rs.MoveNext
    Loop
    ' Eliminar la última coma y espacio en la cadena de resultado
    If Len(resultado) > 0 Then
        resultado = Left(resultado, Len(resultado) - 2)
    End If
    ' Cerrar el recordset
    rs.Close
    ' Asignar el resultado a la función
    UnirRegistros = resultado
End Function

Ejemplo de uso

Dim resultado As String
resultado = UnirRegistros("MiTabla", "CampoReferencia", "CampoAgrupar")
Debug. Print resultado

Cambie "MiTabla" por el nombre de su tabla, "CampoReferencia" por el nombre del campo referencia y "CampoAgrupar" por el nombre del campo a agrupar.

Disculpa la función que le pasé esta mal, cámbiela por esta.

Function UnirRegistros(tabla As String, campoReferencia As String, campoAgrupar As String) As String
    Dim rs As Recordset
    Dim sql As String
    Dim resultado As String
    ' Crear una consulta SQL para obtener los registros a unir
    sql = "SELECT " & campoReferencia & ", " & campoAgrupar & " FROM " & tabla & " ORDER BY " & campoReferencia & ", " & campoAgrupar
    ' Ejecutar la consulta y abrir el recordset
    Set rs = CurrentDb.OpenRecordset(sql)
    Dim refAnterior As Variant
    refAnterior = Null
    ' Recorrer el recordset y concatenar los valores en una cadena
    Do Until rs.EOF
        If IsNull(refAnterior) Then
            resultado = resultado & rs(campoReferencia) & ": " & rs(campoAgrupar) & ", "
        ElseIf rs(campoReferencia) <> refAnterior Then
            resultado = Left(resultado, Len(resultado) - 2) ' Eliminar la última coma y espacio
            resultado = resultado & vbCrLf ' Agregar un salto de línea
            resultado = resultado & rs(campoReferencia) & ": " & rs(campoAgrupar) & ", "
        Else
            resultado = resultado & rs(campoAgrupar) & ", "
        End If
        refAnterior = rs(campoReferencia)
        rs.MoveNext
    Loop
    ' Eliminar la última coma y espacio en la cadena de resultado
    If Len(resultado) > 0 Then
        resultado = Left(resultado, Len(resultado) - 2)
    End If
    ' Cerrar el recordset
    rs.Close
    ' Asignar el resultado a la función
    UnirRegistros = resultado
End Function

La probé con la tabla de mi respuesta del  21 de octubre del 2021 y obtengo.

¿
? UnirRegistros("tbltecnicas","REF","TECNICAS")
100: tecnica1, tecnica2, tecnica3
203: tecnica1, tecnica2
204: TECNICA1
205: 

Mis disculpas.

Esto para Enrique Feijóo revise antes de publicar algo su función carece de lógica de programación da el error.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas