AGRUPAR INFORMACIÓN DE VARIOS LIBROS EN UNA HOJA EXCEL

En esta web ya llevo varios post dedicados al tema de agrupar o consolidar información en Excel, desde agrupar la información de varios archivos a una misma hoja a consolidar la información de todas las pestañas, estos son los post relacionados:

1 – CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNIÓN
2 – CONSOLIDAR INFORMACIÓN DE VARIOS ARCHIVOS EN UNA HOJA EXCEL
3 – CONSOLIDAR INFORMACIÓN DE VARIOS ARCHIVOS EN UNA HOJA EXCEL CON VBA

Y con este post de hoy creo que este tema quedará bastante documentado. Hace unos días, me solicitaron realizar una modificación en la macro del tercer post de la lista que acabo de comentar. La solicitud era que se pudiesen seleccionar los archivos que queremos agrupar en lugar de seleccionar una carpeta para agrupar todo el contenido. Aunque parezca un tema menor creo que es necesario comentar estas modificaciones.

El razón de realizar el post con la carpeta como fuente de los datos, fue por dos motivos: No hay muchas macros publicadas que lo hagan así y por otra parte, en procesos automatizados, es una solución más eficiente que tener que ir seleccionando los archivos. Pero, claro, se puede dar el caso que la información, precisamente, necesite ser agrupada seleccionando individualmente cada archivo que queremos agrupar.

Aprovecharé los archivos del post motivo de la consulta e introduciré algunos cambios en la programación.

Como siempre, imaginad que tenemos la siguiente carpeta con estos 3 archivos y queremos consolidar o agrupar toda la información en una hoja:

consolidar-informacion-de-varios-archivos-en-una-hoja-excel-con-vba1

Para hacerlo vamos a utilizar la siguiente macro:

Sub AGRUPAR_ARCHIVOS()
'Definimos variables
Dim i As Integer, j As Integer, FilaInicio As Integer
Dim iArchivo As String, nArchivo As String, MiLibro As String
Dim dir_Archivo As Variant
Dim iRango As Range, dRango As Range
Dim Hoja_Destino As Worksheet, iLibro As Workbook
'Creamos ventana de diálogo para seleccionar los archivos que queremos agrupar
On Error Resume Next
dir_Archivo = Application.GetOpenFilename(Title:="SELECCIONA ARCHIVOS PARA CONSOLIDAR", MultiSelect:=True, filefilter:="Excel files (*.xls*), *.xls*")
On Error GoTo 0
'Si no seleccionamos archivos, salimos del proceso
If Not IsArray(dir_Archivo) Then
Exit Sub
End If
'Si existen datos en la hoja AGRUPADO, los eliminamos
With ThisWorkbook.Sheets("AGRUPADO")
elimina = Application.CountA(.Range("A:A")) + 1
If elimina > 0 Then .Range("A1:A" & elimina).EntireRow.Delete
End With
'Iniciamos un for con para identificar los archivos seleccionados
If IsArray(dir_Archivo) Then
For j = LBound(dir_Archivo) To UBound(dir_Archivo)
nArchivo = dir_Archivo(j)
'Determinamos a partir de que fila vamos a consolidar los datos
FilaInicio = 1
'Desactivamos actualizacion de pantalla y eventos
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Identificamos el nombre de nuestro libro
MiLibro = ThisWorkbook.Name
'Indicamos la hoja de destino de los datos que queremos consolidar
Set Hoja_Destino = ThisWorkbook.Sheets("AGRUPADO")
'Listamos los archivos Excel a consolidar
iArchivo = nArchivo
'Si la longitud del archivo es cero, salimos del proceso (no existe archivo para consolidar)
If Len(iArchivo) = 0 Then Exit Sub
'Si el nombre del archivo no es igual a nuestro libro seguimos el proceso
If Not iArchivo = MiLibro Then
'Capturamos ruta al iarchivo
Set iLibro = Workbooks.Open(Filename:=nArchivo)
'Contamos las hojas que tiene
fin = iLibro.Sheets.Count
'Iniciamos un bucle por cada hoja, donde seleccionamos los datos desde la fila 2
'hasta el final de la hoja (siempre sin filas en blanco)
'Luego copiamos los datos en la Hoja_Destino, que es la Hoja "AGRUPADO"
'Colocándolos al final de los rangos que se vayan pegando
For i = 1 To fin
iLibro.Sheets(i).Select
Set iRango = iLibro.Sheets(i).Range(Cells(FilaInicio, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set dRango = Hoja_Destino.Range("A" & Hoja_Destino.Cells(Rows.Count, 1).End(xlUp).Row + 1)
iRango.Copy
With dRango
.PasteSpecial xlPasteValues
.PasteSpecial xlFormats
End With
Next
'Cerramos el libro y continuamos el proceso
Application.CutCopyMode = False
iLibro.Close False
End If
Next j
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
' Una vez finalizado, lanzamos mensaje de finalización.
MsgBox ("EL PROCESO HA FINALIZADO CORRECTAMENTE"), vbInformation, "PROCESO DE CONSOLIDACIÓN"
End Sub

Como podéis ver, hemos realizado algunas modificaciones en la macro anterior, entre ellas el tipo de cuadro de diálogo para seleccionar los archivos, con el método .GetOpenFilename y con la propiedad MultiSelect:=True, fundamental para seleccionar varios archivos:

AGRUPAR INFORMACION DE VARIOS LIBROS EN UNA HOJA EXCEL

Dado que estamos seleccionando varios archivos debemos especificar en el código el archivo qué vamos a procesar en cada momento, de ahí que debamos introducir un pequeño bucle indicando esta información, (utilizando matrices).

If IsArray(dir_Archivo) Then
For j = LBound(dir_Archivo) To UBound(dir_Archivo)
nArchivo = dir_Archivo(j)

El resto de la macro es idéntica a la que ofrecí en el post anterior al que nos estamos refiriendo.

Para este ejemplo, no he puesto encabezados de columna en la hoja “AGRUPADO”, de forma que los datos que vayamos a agrupar aparecerán con su encabezado en el resumen final (tal y como podéis ver aquí) este es el resultado de la macro:

AGRUPAR INFORMACION DE VARIOS LIBROS EN UNA HOJA EXCEL1

Cada encabezado representa la información extraída en cada hoja. Para eliminar los encabezados sobrantes con un simple filtro los podremos borrar (dejando el primero) y tendremos toda la información agrupada.

Si por el contrario, sabemos que todas las hojas tienen la misma estructura, con los mismos campos, podemos indicar el encabezado en la hoja “AGRUPADO”, pero entonces tendríamos que realizar las siguientes modificaciones en la macro (os dejo solo la parte que se modifica):

'Si existen datos en la hoja AGRUPADO, los eliminamos
With ThisWorkbook.Sheets("AGRUPADO")
elimina = Application.CountA(.Range("A:A")) 'eliminamos el +1
If elimina > 1 Then .Range("A2:A" & elimina).EntireRow.Delete
End With
'Iniciamos un for con para identificar los archivos seleccionados
If IsArray(dir_Archivo) Then
For j = LBound(dir_Archivo) To UBound(dir_Archivo)
nArchivo = dir_Archivo(j)
'Determinamos a partir de que fila vamos a consolidar los datos
FilaInicio = 2

El resultado sería el siguiente:

AGRUPAR INFORMACION DE VARIOS LIBROS EN UNA HOJA EXCEL2

Es decir, que podemos configurar el proceso según nuestras necesidades.

Es una macro con la que he disfrutado bastante escribiendo el código, ahora solo espero que os resulte de utilidad.

Descarga el archivo de ejemplo pulsando en: AGRUPAR INFORMACIÓN DE VARIOS LIBROS EN UNA HOJA EXCEL

Y la carpeta de ejemplo con los 3 archivos para realizar pruebas:  ARCHIVOS DE EJEMPLO PARA PRUEBAS

 

Anuncios

FUNCIONES MATRICIALES PARA OBTENER MEDIANA, MAX, MIN Y OTRAS FÓRMULAS.

Hola  a todos:

Hoy quiero escribir acerca de varios temas en este post, uno de ellos es la utilización de las fórmulas matriciales para obtener datos relevantes en conjuntos de información elevados.

Para poder ilustrar el ejercicio, vamos a realizar un ejemplo, imaginad que tenéis a los alumnos de dos clases (1º -A y 1º-B) y que os han enviado las notas por alumno de las siguientes asignaturas, de Física, Química y Matemáticas:

FUNCIONES MATRICIALES PARA OBTENER MEDIANA, MAX, MIN Y OTRAS FORMULAS

Como podéis ver, hay de todo … ¡desde un 10 hasta un 1!, (no he querido poner un cero, creo que todo el mundo, por el mero hecho de estar en un aula ya merece ese punto de cortesía).

Ahora resulta que necesitáis saber cual es la mediana, pero no el dato general, para este ejemplo, la mediada de todos los estudiantes de 1ªA en Física, esto lo podéis hacer mediante las siguientes fórmulas matriciales:

Hallando el PERCENTIL 50 que equivale a la mediana:

{=PERCENTIL(SI($C$2:$C$65000=C2;SI($D$2:$D$65000=D2; $E$2:$E$65000));50%)}

O directamente usando la función MEDIANA

{=MEDIANA(SI($C$2:$C$65000=C2;SI($D$2:$D$65000=D2; $E$2:$E$65000)))}

En ambos casos el resultado será el mismo, particularmente me gusta usar la fórmula de los percentiles 🙂

El resultado es el siguiente:

FUNCIONES MATRICIALES PARA OBTENER MEDIANA, MAX, MIN Y OTRAS FORMULAS1

Efectivamente, el resultado es un 6,5. Como se puede apreciar en ambas fórmulas matriciales se combinan los criterios de la CLASE y de la ASIGNATURA, para obtener el resultado específico de los datos seleccionados.

Ahora que tenemos la mediana, queremos obtener en las dos columnas siguientes el resultado mínimo y el máximo para el mismo colectivo, es decir que el máximo debería ser el 10 y el mínimo el 4. Las fórmulas a utilizar serían las siguientes:

Para hallar el valor máximo de las notas de los estudiantes de 1:

{=MAX(SI($C$2:$C$65000=C2;SI($D$2:$D$65000=D2; $E$2:$E$65000)))}

O directamente usando la función MEDIANA

{=MIN(SI($C$2:$C$65000=C2;SI($D$2:$D$65000=D2; $E$2:$E$65000)))}

El resultado es el esperado:

FUNCIONES MATRICIALES PARA OBTENER MEDIANA, MAX, MIN Y OTRAS FORMULAS2

Y como resulta que queremos automatizar esta información cada cierto tiempo, hemos decidido programar estos cálculos en VBA.

Como sabéis, en VBA podemos utilizar la propiedad  .Formula que representa la fórmula del objeto en notación del estilo A1. Esto es muy útil, dado que podemos expresar el resultado del cálculo, no como valores, sino como la propia fórmula, es decir que dejará el resultado con la fórmula introducida.

Para el caso de las fórmulas matriciales, debemos especificar en el código .FormulaArray =
Teniendo en cuenta esto, ya podemos automatizar el cálculo, esta sería la macro:

Sub VARIAS_MATRICIALES()
'Definimos variables
Dim i As Integer, fin As Integer, elimina As Integer
With Sheets("DATOS")
elimina = Application.CountA(Worksheets("DATOS").Range("A:A"))
If elimina > 0 Then Worksheets("DATOS").Range("F2:H" & elimina).ClearContents
fin = Application.CountA(.Range("A:A"))
'Aplicamos fórmula matricial para hallar la mediana, el valor máximo y el mínimo según criterios indicados
For i = 2 To fin
.Cells(i, 6).FormulaArray = "=percentile(if($C$2:$C$65000=C" & i & ",if($D$2:$D$65000=D" & i & " , $E$2:$E$65000)),50%)"
.Cells(i, 7).FormulaArray = "=max(if($C$2:$C$65000=C" & i & ",if($D$2:$D$65000=D" & i & " , $E$2:$E$65000)))"
.Cells(i, 8).FormulaArray = "=min(if($C$2:$C$65000=C" & i & ",if($D$2:$D$65000=D" & i & " , $E$2:$E$65000)))"
Next
End With
End Sub

Obviamente, para este ejemplo, he utilizado unas fórmulas determinadas, pero se pueden usar múltiples funciones, por ejemplo, la desviación estándar, la suma, el promedio, cuartiles,  etc.

Me ha parecido útil este post por la versatilidad que nos ofrecen las matriciales a la hora de obtener datos relevantes para nuestros análisis y por compartir el uso de la propiedad .Formula en vuestros proyectos VBA.

Estas fórmulas pueden ser ideales para multitud de tareas, análisis de bandas salariales, ventas, etc y además se pueden introducir en tablas o gráficos dinámicos que agregarán valor añadido a nuestros análsis.

Os recuerdo que las matrices se introducen: seleccionando la celda que contiene la fórmula, pulsando en F2 , seleccionamos la fórmula y luego presionamos CTRL + MAYUS + ENTRAR

Descarga el archivo de ejemplo pulsando en: FUNCIONES MATRICIALES PARA OBTENER MEDIANA, MAX, MIN Y OTRAS FÓRMULAS

 

EXTRAER REGISTROS ÚNICOS CON UNA CONSULTA SQL USANDO DISTINCT

Hola a todos 🙂

Espero que todo vaya bien!. Llevo unos días con ganas de escribir este post, pero la verdad es que me habéis enviado bastantes consultas, y ya sabéis que lo primero es atender las dudas de los lectores y luego escribir las entradas del blog.

El post de hoy surge por una consulta en la que se me pedía una macro para extraer registros únicos de una hoja a otra. Así como para extraer los registros únicos dentro de la misma hoja podemos usar el filtro avanzado, y así lo publique en su momento: EXTRAER REGISTROS ÚNICOS CON FILTRO AVANZADO EN VBA, para pasarlo a otra hoja debemos utilizar otro tipo de código, de hecho podemos utilizar diferentes métodos.

Hoy veremos uno de ellos, utilizaremos ADO y una consulta SQL en la que incluyendo la palabra clave DISTINCT podremos extraer los registros únicos a otra hoja.

Vamos con el siguiente ejemplo, imaginad que tenemos nuestra hoja de Excel con una serie de registros duplicados:

EXTRAER REGISTROS ÚNICOS CON UNA CONSULTA SQL USANDO DISTINCT

Y queremos pasar a la hoja UNICOS todos los registros SIN duplicados. Para ello vamos utilizar el siguiente código:

Sub CONSULTA_SQL_UNICOS()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String, Res As String
Dim cnn As ADODB.Connection, i As Integer, MiLibro As String
'Limpiamos hoja con los registros únicos
Eliminar = Application.CountA(Worksheets("UNICOS").Range("A:A"))
If Eliminar > 0 Then Worksheets("UNICOS").Range("A1:GG" & Eliminar).ClearContents
'realizamos consulta SQL incorporando la palabra clave Distinct
obSQL = "SELECT distinct * FROM [DATOS$] "
'Guardamos el nombre del libro activo
MiLibro = ActiveWorkbook.Name
'Realizamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Procedemos a grababar 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
Do Until Dataread.EOF
Res = obRes & Dataread.Fields(0).Value & " " & Dataread.Fields(1).Value
Dataread.MoveFirst
'Copiamos los datos a la hoja UNICOS
With Worksheets("UNICOS").Select
Worksheets("UNICOS").Cells(2, 1).CopyFromRecordset Dataread
End With
'Grabamos los nombres de cada encabezado de 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("UNICOS").Cells(1, i + 1) = dfecha
Next
Loop
End Sub

Ya sabéis que para este tipo de método es necesario activar la referencia Microsoft ActiveX Data Object 2.8 Library en el editor de VBA:

exportar-una-tabla-o-consulta-de-access-a-excel-con-ado2

Siguiendo con el código, lo realmente importante es que en la consulta SQL estamos utilizando la palabra clave DISTINCT, la cual elimina los registros que se encuentran duplicados. El resto del código es el que solemos utilizar en esta web para este tipo de consultas.

El resultado de aplicar la macro es el siguiente:

EXTRAER REGISTROS ÚNICOS CON UNA CONSULTA SQL USANDO DISTINCT1

Como podéis ver, ya tenemos nuestros datos sin duplicados.

Y esto es todo, en próximos post, publicaré otra forma más sencilla de extraer registros únicos. Espero que os sea de utilidad, como siempre os dejo la macro:

Descarga el archivo de ejemplo pulsando en: EXTRAER REGISTROS ÚNICOS CON UNA CONSULTA SQL USANDO DISTINCT

 

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNIÓN

Hola a todos:

Hace unos días recibí una consulta acerca de cómo agrupar la información de varias hojas en una hoja específica del mismo libro.

Aunque tengo publicaciones con macros para agrupar información de varios libros,  el método utilizado fue mediante bucles (For – next). Para esta petición utilizaré otro método, trabajaré con ADO y realizaré una consulta de UNION para consolidar la información de las hojas seleccionadas.

Dado que el usuario tendrá siempre la misma estructura en la información de esas hojas y además serán tres, esta macro será perfecta para este trabajo. Con ADO conseguiremos mayor rapidez en la ejecución del código y, si cabe mayor claridad.

Veamos las tres hojas que vamos a consolidar, las llamaré TABLA1, TABLA2 y TABLA3 y la hoja que recibirá toda la información se llamará CONSOLIDADO:

La estructura sería esta:

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNION

Tal como podéis ver, cada una de las tablas tiene la misma estructura que la que muestro arriba. Un ID, Nombre, Estudios, Inglés, Vehículo, Provincia y Edad.

Antes de poner la macro, me gustaría volver a incidir en que es imprescindible que las tablas tengan las mismas columnas con los mismos nombres. Si esto no es así, la macro no funcionará.

Ahora sí, ya podéis pegar el siguiente código en un módulo estándar:

Sub CONSULTA_SQL_UNION()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String, Res As String
Dim cnn As ADODB.Connection, i As Integer, MiLibro As String
'Limpiamos hoja que consolida, CONSOLIDADO
Eliminar = Application.CountA(Worksheets("CONSOLIDADO").Range("A:A"))
If Eliminar > 0 Then Worksheets("CONSOLIDADO").Range("A1:GG" & Eliminar).ClearContents
'realizamos consulta SQL de UNION y no tenemos en cuenta los registros nulos
obSQL = "SELECT * FROM [TABLA1$] WHERE NOT [TABLA1$].[ID] IS NULL UNION " & _
"SELECT * FROM [TABLA2$] WHERE NOT [TABLA2$].[ID] IS NULL UNION " & _
"SELECT * FROM [TABLA3$] WHERE NOT [TABLA3$].[ID] IS NULL"
'Guardamos el nombre del libro activo
MiLibro = ActiveWorkbook.Name
'Realizamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Procedemos a grababar 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
Do Until Dataread.EOF
Res = obRes & Dataread.Fields(0).Value & " " & Dataread.Fields(1).Value
Dataread.MoveFirst
'Copiamos los datos a la hoja CONSOLIDADO
With Worksheets("CONSOLIDADO").Select
Worksheets("CONSOLIDADO").Cells(2, 1).CopyFromRecordset Dataread
End With
'Grabamos los nombres de cada encabezado de 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("CONSOLIDADO").Cells(1, i + 1) = dfecha
Next
Loop
End Sub

Antes de ejecutar el código debéis verificar que tenéis la referencia: Microsoft ActiveX Data Object 2.8 Library. En este archivo no es necesario que la marquéis (ya la he marcado yo), pero si pegáis el códido en un libro nuevo, sí que la tendréis que marcar.

exportar-una-tabla-o-consulta-de-access-a-excel-con-ado2

El resultado de aplicar la macro es el siguiente:

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNION1

Y ya tenemos los registros de las hojas especificadas en la hoja CONSOLIDADO. En este código si existen duplicados, es decir dos filas o más idénticas, importará solo uno, y también si existen elementos nulos (null) no los tendrá en cuenta. Si queremos que tuviese en cuenta los duplicados, es decir, que los importase, debemos poner “ALL” después de UNION, de esta forma estaremos especificando que unimos todo (incluidos duplicados):

obSQL = "SELECT * FROM [TABLA1$] WHERE NOT [TABLA1$].[ID] IS NULL UNION ALL " & _ "SELECT * FROM [TABLA2$] WHERE NOT [TABLA2$].[ID] IS NULL UNION ALL " & _
"SELECT * FROM [TABLA3$] WHERE NOT [TABLA3$].[ID] IS NULL"

Obviamente, sobre los nulos, no vamos a querer que se cuelen filas en blanco o con caracteres extraños, por eso resulta imprescindible incluir en la sentencia el famoso Not Is Null 🙂

Y esto ha sido todo, os dejo el archivo de ejemplo:

Descarga el archivo de ejemplo pulsando en: CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNIÓN

 

EXPORTAR INFORME DE TABLA DINÁMICA EN LA MISMA HOJA

Hola todos 😉

Hoy me gustaría ampliar parte de un post anterior: EXPORTAR INFORME DE TABLA DINAMICA A UN LIBRO NUEVO en el que mediante una macro generábamos automáticamente informes de tabla dinámica y exportábamos cada uno de ellos a un nuevo libro.

Hace unos días un lector quería saber qué modificaciones tenía que hacer en la macro para que esos informes no se generasen en un libro nuevo, sino que se generasen en la misma hoja, uno por pestaña.

Lo cierto, es que la modificación no es compleja, solo hemos de eliminar de la macro anterior toda referencia a “nuevo libro” y dejar que los informes se generen automáticamente en la hoja.

Voy a utilizar un ejemplo nuevo para ilustrar el ejercicio, en este caso, volvemos a los datos por provincias y por número de personas en determinados años. Esta sería la información principal, que la tenemos en una hoja denominada “DATOS”:

EXPORTAR INFORME DE TABLA DINAMICA EN LA MISMA HOJA.jpg

El siguiente paso es insertar una tabla dinámica y en la pestaña Diseño aplicar “mostrar en forma de esquema”, de esta forma aparecerá el título del primer campo seleccionado, en nuestro caso: “Provincia”

EXPORTAR INFORME DE TABLA DINAMICA EN LA MISMA HOJA1

Una vez que tenemos la tabla creada, procedemos escribir nuestro código:

Sub GENERAR_INFORMES_TABLA()
Dim i As Integer
Dim Ini As Integer
Dim Fin As Integer
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
Sheets("TABLA").Select
With Sheets("TABLA")
'indicamos la fila siguiente a la primera fila con datos: 01 Araba/Álava
Ini = Columns(1).Range("A1").End(xlDown).Row
'Contamos los todas las provincias de la tabla dinámica1, es decir las 52
Fin = .PivotTables(1).PivotFields("PROVINCIA").PivotItems.Count
'Inciamos un bucle donde por cada provincia generamos informe (ShowDetail)
For i = 1 To Fin
'para mostrar el informe debemos hacer referencia al campo de valor de la tabla
.Cells(i + Ini, 2).ShowDetail = True
'Nombramos la pestaña con el nombre de la provincia.
ActiveSheet.Name = Application.WorksheetFunction.Substitute((.Cells(i + Ini, 1).Value), "/", "_")
Next i
End With
Application.ScreenUpdating = True
End Sub

Lo que vamos a conseguir con esta macro es generar tantos informes como ítems tengamos en la tabla dinámica y los colocaremos en una pestaña cada uno. Dado que estamos nombrando las pestañas de las hojas, debemos tener en cuenta:

– El nombre de la hoja no puede superar los 31 caracteres.
– No ha de contener los siguientes caracteres: \  / ¿ ? * [  ]
– No puede quedar el nombre en blanco.

Seguro que os habéis fijado que en nuestros datos tenemos uno de esos símbolos “/”: por ejemplo en 01 Araba/Álava. Para solucionar este problema sin tener que modificar los datos, realizaremos el cambio en el mismo momento que nombramos la hoja, simplemente sustituyendo “/” por “_” (por ejemplo). Esta es la línea del código en la que hacemos este reemplazo:

ActiveSheet.Name = Application.WorksheetFunction.Substitute((.Cells(i + Ini, 1).Value), "/", "_")

Por supuesto, también podríamos utilizar la función Mid () si necesitásemos extraer los 31 caracteres de la hoja y la función Trim() para eliminar los espacios en blanco.

Una vez aplicada la macro, el resultado sería el siguiente:

EXPORTAR INFORME DE TABLA DINAMICA EN LA MISMA HOJA2.jpg

Y ya tenemos una pestaña por provincia con el informe correspondiente.

Y estos ha sido todo, espero que os sea de utilidad:

Descarga el archivo de ejemplo pulsando en: EXPORTAR INFORME DE TABLA DINÁMICA EN LA MISMA HOJA

 

 

GENERAR ORGANIGRAMA JERÁRQUICO POR ÁREAS CON SMARTART

Hola  todos. ¿Qué tal estáis? 🙂 espero que bien!

En esta web ya llevo varios post dedicados al mundo de SmartArt en Excel, pero complementándolo con VBA. SmartArt ofrece un sensacional efecto visual y un acabado muy profesional en nuestro trabajos. Existen multitud de gráficos y cada uno tiene unas especificaciones concretas en cuanto a utilidad y fin, y eso también se aplica a VBA a la hora de programar un gráfico concreto.

Podréis ver varios ejemplos si escribís en el el buscador de la web la palabra SmartArt, tanto para generar organigramas de varios tipos, como árboles de decisión o estructuras de procesos.

Hoy quiero dedicar un post a un tipo concreto de gráfico de jerarquía, que se denomina en SmartArt como “Jerarquía de tabla”, lo podéis ver en la ficha:

generar-organigrama-jerarquico-por-areas-con-smartart4

Para realizar un ejemplo, he rescatado unos datos usados en uno de los últimos post dedicados a este tema:

generar-organigrama-jerarquico-por-areas-con-smartart2

 

Tenemos la distribución por áreas de una empresa, y necesitamos crear un gráfico que nos muestre un organigrama, empezando por las últimas áreas en la jerarquía hasta la última (Gerencia). No queremos nombres de personas, solo áreas y que se visualicen en bloques.

Para hacerlo vamos a utilizar el siguiente código:

Sub JERARQUIA_POR_AREAS()
'Declaramos variables
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i As Integer, Fin As Integer
With Sheets("ESTRUCTURA")
.Select
'Eliminamos TODOS objetos en la hoja "ESTRUCTURA"
For Each Shape In .Shapes
Shape.Delete
Next
'Insertamos objeto SmartArt, en este caso "Jerarquía de tabla"
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/hierarchy4")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
'Verificamos número de nodos necesarios contando los ítems de la página "DATOS"
Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
'Creamos nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
'Eliminamos nodos sobrantes y los nombramos con la información de la hoja "DATOS"
For i = 2 To Fin
Do While oNodos(i - 1).Level < Sheets("DATOS").Range("B" & i).Value
oNodos(i - 1).Demote
Loop
With oNodos(i - 1)
.TextFrame2.TextRange.Text = Sheets("DATOS").Range("A" & i)
End With
Next
'Eliminamos último nodo (estará vacío al tener encabezado la hoja "DATOS")
oNodos(Fin).Delete
'aplicamos estilos
For Each Shape In .Shapes
'Colores
Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent2_1")
'Estilos rápidos
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/simple2")
'Dimensionamos la imagen
With .Shapes(1)
.Height = 581.25 'Alto del objeto
.Width = 1375.5 'Ancho del objeto
.Top = 6.749921 ' Altura en la hoja
.Left = 14.25 ' A la izquierda de la hoja
End With
Next
End With
End Sub

El resultado es el siguiente:

generar-organigrama-jerarquico-por-areas-con-smartart1

Como podéis apreciar, obtenemos el efecto deseado, para este ejemplo he utilizado un estilo rápido y colores específicos, pero podéis indicar los que más os gusten, por ejemplo, con colores por cada unidad jerárquica:

generar-organigrama-jerarquico-por-areas-con-smartart3

Para obtener los ID y los nombres, podéis visitar este post: OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RÁPIDOS DE SMARTART PARA VBA 

Otro consejo 🙂 para este ejemplo estoy utilizando una pantalla grande, es posible que deseéis cambiar el tamaño del gráfico y la posición, para hacer de una forma eficaz, utilizad la pantalla de “inmediato” de vuestro editor de VBA. Primero configurar manualmente el gráfico en la pantalla del ordenador (el aspecto y tamaño que os gustaría que tuviese) y luego, en la pantalla de inmediato, mediante estos comandos obtendréis el ancho, el largo y posición dentro de la hoja, por ejemplo, la altura que debemos indicar:

generar-organigrama-jerarquico-por-areas-con-smartart5

Y este ha sido el ejercicio de hoy. Espero que con esta macro podáis aplicar un estilo diferente a vuestro proyectos 🙂

Descarga el archivo pulsando en: GENERAR ORGANIGRAMA JERÁRQUICO POR ÁREAS CON SMARTART

 

EXTRAER SALDOS NEGATIVOS Y POSITIVOS EN LOS MOVIMIENTOS DE UNA CUENTA

Hola a todos.

Llevo varios post escritos en los que el tema a tratar son las consultas de los lectores. Creo que esto es muy importante, dado que son casos totalmente reales y seguro que se dan más frecuentemente.

Para el caso de hoy voy a presentar un pequeño proceso que extrae los saldos positivos y negativos de los movimientos de una cuenta contable. Esta consulta me la formuló una lectora, que decía así:

Buenos días:

Tengo una relación de cuentas y movimientos por fechas y necesitaría poner los importes negativos en una columna y los positivos en otra. Y también que aparezca el sumatorio de los saldos al final de cada columna, ¿podrías ayudarme?. Te envío un archivo de prueba.

Muchas gracias.

Para hacernos una idea de los datos, he confeccionado un pequeño ejemplo con datos generados aleatoriamente, estos serían los movimientos, las fechas y el resto de la información:

EXTRAER SALDOS NEGATIVOS Y POSITIVOS EN LOS MOVIMIENTOS DE UNA CUENTA.jpg

Para poder realizar la consulta que nos plantea nuestra compañera existen varios métodos, podemos usar un filtro avanzado (pero en VBA), podemos usar una consulta SQL usando ADO, o podemos usar un bucle que vaya acumulando los datos en la columna específica. Para este ejercicio usaré el tercer método, y en concreto una instrucción For-Next (podríamos utilizar cualquier otra estructura de bucle).

La macro que vamos a utilizar es la siguiente:

Sub extraer_saldos()
'Declaramos las variables a utilizar
Dim i As Integer, n As Integer, contador As Integer
'Desactivamos parpadeo de pantalla
Application.ScreenUpdating = False
'Hacemos referencia a la hoja Datos
With Sheets("DATOS")
'Cuando ejectemos la macro, limpiamos el área seleccionada si contiene información
fin = Application.CountA(.Range("A:A"))
If fin > 1 Then .Range("F2:I" & fin, "K2:N" & fin).Clear
'Si no marcamos el mes,lanzamos un mensaje de advertencia y paramos salimos del proceso
nMes = .Cells(2, 16).Value
If nMes = vbNullString Then
MsgBox ("INDICA EL MES (EN NÚMERO) PARA EXTRAER LA INFORMACIÓN"), vbExclamation
Exit Sub
End If
'iniciamos el bucle para pasar los datos con signo negativo a las columnas especificadas
n = 2
For i = 2 To fin
contador = 0
If .Cells(i, 4) < 0 And Month(.Cells(i, 2)) = nMes Then contador = contador + 1
If contador = 1 Then
.Range("F" & n) = .Cells(i, 1).Value
.Range("G" & n) = .Cells(i, 2).Value
.Range("H" & n) = .Cells(i, 3).Value
.Range("I" & n) = .Cells(i, 4).Value
n = n + 1
End If
Next i
'realizamos el sumatorio en la última celda de los importes negativos
RngNeg = Application.CountA(.Range("F:F"))
.Cells(RngNeg + 1, 9) = Application.WorksheetFunction.Sum(.Range("I2:I" & RngNeg))
With .Cells(RngNeg + 1, 9)
.Font.Bold = True
.Style = "Currency"
End With
'iniciamos el bucle para pasar los datos con signo positivo a las columnas especificadas
n = 2
For i = 2 To fin
contador = 0

If .Cells(i, 4) > 0 And Month(.Cells(i, 2)) = nMes Then contador = contador + 1
If contador = 1 Then
.Range("K" & n) = .Cells(i, 1).Value
.Range("L" & n) = .Cells(i, 2).Value
.Range("M" & n) = .Cells(i, 3).Value
.Range("N" & n) = .Cells(i, 4).Value
n = n + 1
End If
Next i
'realizamos el sumatorio en la última celda de los importes negativos
RngNeg = Application.CountA(.Range("K:K"))
.Cells(RngNeg + 1, 14) = Application.WorksheetFunction.Sum(.Range("N2:N" & RngNeg))
With .Cells(RngNeg + 1, 14)
.Font.Bold = True
.Style = "Currency"
End With
End With
Application.ScreenUpdating = True
End Sub

Cuando ejecutamos la macro, el resultado que obtener es el siguiente:

extraer-saldos-negativos-y-positivos-en-los-movimientos-de-una-cuenta1

Como podéis observar, hemos extraído los movimientos positivos y negativos del mes de febrero y realizado el sumatorio en cada columna para obtener el saldo final.

En este caso específico, la lectora solicitaba filtrar bajo el criterio del mes, pero podríamos realizar el filtro en base a la cuenta, el cliente, etc. Es en la macro donde podréis especificar nuevos condicionales que se adapten a vuestras necesidades.

Es un proceso simple y con muchas posibilidades, os animo a ir examinando el código poco a poco y, si es necesario, lo vayáis adaptando a vuestros trabajos.

Descarga el archivo pulsando en: EXTRAER SALDOS NEGATIVOS Y POSITIVOS EN LOS MOVIMIENTOS DE UNA CUENTA