Estimados lectores, ¿qué tal estáis? espero que bien!
La semana pasada no subí ningún post porque tuve que ocuparme de otros asuntos y no tuve tiempo… pero ahora sí 🙂
Tal y como propuse en LinkedIn, sugerí que fueseis vosotros mismos los encargados de proponer el post de hoy y he tenido varias consultas, algunas ya las he solucionado sobre la marcha y otras las iré subiendo como ejemplo.
Como recordaréis hace unas semanas subí una macro que permitía transponer los datos horizontalmente mediante la utilización del código de una tabla dinámica, aquí: TRANSPONER DATOS PERSONALIZADOS EN EXCEL, pues un lector me preguntaba si existía otra alternativa para realizar este trabajo que no pasase por invocar un tabla dinámica.
Efectivamente, existen varias alternativas, pero realizando una labor un poco más creativa, me he decido por realizar este ejercicio mediante una consulta SQL y, en concreto, mediante una consulta de referencias cruzadas que tanto gusta hacer en Access.
Como quiero realizar una comparación voy a utilizar la misma base de datos que en el ejemplo anterior, esta:
Para poder realizar la tarea debemos entonces tener en cuenta el código SQL necesario para realizar la tarea, os dejo la línea que nos va a permitir realiza este trabajo:
'Indicamos los parámetros de la consulta SQL de referencias cruzadas
obSQL = "TRANSFORM Sum([DATOS$].[IMPORTE]) AS [SumaDeIMPORTE] " & _
"SELECT [DATOS$].[ID], [DATOS$].[NOMBRE] " & _
"FROM [DATOS$] " & _
"GROUP BY [DATOS$].[ID], [DATOS$].[NOMBRE] " & _
"ORDER BY cdate([DATOS$].[FECHA]) " & _
"PIVOT cdate([DATOS$].[FECHA])"
Mediante esta consulta conseguiremos ordenar la tabla mediante el cruce del dato «Fecha» , con los datos «Nombre» e «ID» mostrando la suma del importe de cada uno.
En Access esto se realizaría así:
Pero como Access no siempre se tiene la posibilidad de contar con él, no todas las organizaciones lo permiten (normalmente por temas de seguridad y de coste por licencia), tenemos que hacerlo en Excel.
Para ello, utilizaremos el siguiente código que reproduzco:
Sub TransponerHorizontalSql()
Dim i As Double
Dim dfecha As Variant
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection
'Cada vez que ejecutemos la consulta borramos los datos de la consulta anterior en la hoja TRANSPONER_
'si se produce un error por estar la hoja vacía, saltamos directamente al proceso de consulta a través de la etiqueta control_e
On Error GoTo control_e
LIMPIARDATOS = Application.CountA(Worksheets("TRANSPONER").Range("a:a"))
Worksheets("TRANSPONER").Range("A1:U" & LIMPIARDATOS).ClearContents
control_e:
'Indicamos los parámetros de la consulta SQL de referencias cruzadas
obSQL = "TRANSFORM Sum([DATOS$].[IMPORTE]) AS [SumaDeIMPORTE] " & _
"SELECT [DATOS$].[ID], [DATOS$].[NOMBRE] " & _
"FROM [DATOS$] " & _
"GROUP BY [DATOS$].[ID], [DATOS$].[NOMBRE] " & _
"ORDER BY cdate([DATOS$].[FECHA]) " & _
"PIVOT cdate([DATOS$].[FECHA])"
'Iniciamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\TRANSPONER_MEDIANTE_CONSULTA_SQL_REFERENCIAS_CRUZADAS.xls"
.Properties("Extended Properties") = "Excel 8.0; HDR=YES"
.Open
End With
'Procedemos a grabar los datos de la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
'Grabamos los cabeceros de cada columna
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
dfecha = CDate(Dataread.Fields(i).Name)
Else
dfecha = Dataread.Fields(i).Name
End If
Worksheets("TRANSPONER").Cells(1, i + 1) = dfecha
Next
'Copiamos los datos de la consulta de referencias cruzadas
With Worksheets("TRANSPONER").Select
Worksheets("TRANSPONER").Cells(2, 1).CopyFromRecordset Dataread
End With
End Sub
Con esta macro, se genera automáticamente la información requerida, y el resultado es exactamente igual al del post anterior donde utilizábamos las tablas dinámicas.
Es de interés el código aplicado para grabar los cabeceros de columnas:
'Grabamos los cabeceros de cada columna
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
dfecha = CDate(Dataread.Fields(i).Name)
Else
dfecha = Dataread.Fields(i).Name
End If
Worksheets("TRANSPONER").Cells(1, i + 1) = dfecha
Next
Con la inestimable ayuda de mi compañero Ángel, lo hemos realizado de forma que la grabación de los datos se realice correctamente y formatee las fechas y el texto de forma precisa definiendo una variable «variant» para dicho cometido.
Otra parte del código que es importante es la que he marcado en rojo y ahora comento
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\TRANSPONER_MEDIANTE_CONSULTA_SQL_REFERENCIAS_CRUZADAS.xls"
Este código hace referencia a que la macro busca o se ejecuta en el libro activo (este libro) y por lo tanto debe llevar el mismo nombre, es decir que si cambiáis el nombre del archivo pero no la referencia en la macro, saltará un error.
Si quisierais que la macro hiciese referencia a otro libro, tan solo tendríais que modificar un poco el código, de forma que aparezca la ruta hacia la carpeta en la que se guarda el archivo, el ejemplo que pongo es de mi equipo:
.ConnectionString = "DATA SOURCE=" + "C:\Users\USUARIO\Downloads\TRANSPONER_MEDIANTE_CONSULTA_SQL_REFERENCIAS_CRUZADAS.xls"
Una vez ejecutada la macro el resultado es este, ¿os suena? … ¡¡sí, es idéntico al del post anterior:!!
Pues aquí finaliza la consulta y este lector ya puede poner en práctica el código desarrollado. Ha sido un trabajo interesante que añade valor a VBA incorporando las posibilidades de SQL y su potencia para realizar consultas.
Importante: si vinculáis la hoja con otro archivo y es diferente de .xls debéis modificar en la conexión los siguientes elementos:
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Excel 12.0; HDR=YES"
Espero que os sea de utilidad también a todos vosotros 🙂
Descarga el archivo de ejemplo pulsando en: TRANSPONER MEDIANTE CONSULTA SQL REFERENCIAS CRUZADAS
Muy buenas tardes,
podria sumar todos los datos de un ID al trasponer los datos??
Saludos.
Hola Juan,
Sí, se pueden sumar todos los importes de los ID. Tan solo hay que añadir a la consulta SQL lo siguiente:
Sum([DATOS$].[IMPORTE]) AS [Total de IMPORTE]
Quedando de la siguiente forma:
obSQL = "TRANSFORM Sum([DATOS$].[IMPORTE]) AS [SumaDeIMPORTE] " & _
"SELECT [DATOS$].[ID], [DATOS$].[NOMBRE] ,Sum([DATOS$].[IMPORTE]) AS [Total de IMPORTE] " & _
"FROM [DATOS$] " & _
"GROUP BY [DATOS$].[ID], [DATOS$].[NOMBRE] " & _
"ORDER BY cdate([DATOS$].[FECHA]) " & _
"PIVOT cdate([DATOS$].[FECHA])"
Saludos.
Te envío el archivo por correo.
ME GUSTARIA SELECCIONAR LA FECHA EN UN COMBO Y TRANSPONERLO
Hola Luis:
Para que te pueda ayudar necesito que me envíes un archivo de ejemplo con la información que deseas trasponer (acompañado de una explicación). Sólo así podré ayudarte.
Saludos.