CERRAR UN PROGRAMA DESDE EXCEL CON VBA

Hola a todos 🙂

Estos días tenía pensado subir algún post relacionado con la minería de datos y la utilización de variables estadísticas para obtener datos y resultados relevantes en nuestras investigaciones.

Pues bien, ese artículo tendrá que esperar, el motivo es que esta semana he tenido muchas consultas y algunas han sido (y siguen siendo) bastante complejas.

Pero como me encanta publicar cosas nuevas en la web, hoy os voy a dejar un código en VBA que tiene como finalidad la de cerrar desde Excel cualquier programa que tengamos abierto en nuestro equipo.

Por ejemplo, si tenemos Word abierto y necesitamos cerrarlo, o Acrobat, etc … podemos utilizar esta macro:

Sub Cierra_Programa()
'Declaramos variables
Dim cObj As Object
Dim Programa As Object
Dim Proceso As Object
'Realizamos una consulta SQL para verificar si el programa está activo, en proceso.
Set cObj = GetObject("winmgmts://.")
Set Proceso = cObj.ExecQuery("SELECT * FROM " & _
"Win32_Process WHERE Name = 'winword.exe'")
'Con un For recorremos la consulta y cerramos el programa
For Each Programa In Proceso
On Error Resume Next
Call Programa.Terminate
On Error GoTo 0
Next
'Liberamos variables
Set Proceso = Nothing
Set cObj = Nothing

End Sub

En este ejemplo estamos cerrando Word, pero si quisiéramos cerrar Acrobat Reader porque tenemos uno o varios PDF’s abiertos, tendríamos que cambiar esto (en rojo) en la macro:

'"Win32_Process WHERE Name = 'AcroRd32.exe'")

O para el bloc de notas:

"Win32_Process WHERE Name = 'notepad.exe'")

Es una macro muy sencilla y que nos puede solucionar muchos dolores de cabeza cuando necesitamos cerrar desde la aplicación que hemos creado en Excel algún programa.

No creo que sea necesario adjuntar documento para esta ocasión, dado que sencillamente solo tenéis que copiar el código en vuestro editor de VBA en un módulo estándar y aplicarlo.

Espero que os sea de utilidad.

Saludos!!

Anuncios

EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA ALFANUMÉRICA UTILIZANDO TEXTO EN COLUMNAS

Hace unos días os dejé un post de cómo se podía extraer información de una cadena de texto alfanumérica, utilizando varias funciones conseguíamos el dato que necesitábamos: EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA DE DATOS

Pues bien, me han vuelto a solicitar otra macro que sea capaz de extraer determinada información, el enunciado de la consulta es el siguiente:

Buenas! quisiera saber si se puede modificar el código de tal manera que permita extraer dos números diferentes que corresponden a diferentes cosas de una misma cadena de texto, y almacenarlas en dos celdas diferentes, por ejemplo: “las condiciones ambientales del experimento fueron 24,5 grados y 1,5 atmósferas ” poder extraer ambos datos y almacenarlos en celdas contiguas.

Bien, al igual que el post original, podríamos solucionar este problema de forma sencilla utilizando la siguiente macro, de hecho esta fue la macro que hice en ese momento:

Sub Extrae_numeros()
Dim i As Integer, j As Integer, Micelda As String, nCifra As Double
With Sheets("Hoja1")
fin = Application.CountA(.Range("A:A"))
For j = 2 To fin
Micelda = .Cells(j, 1)
For i = Len(Micelda) To 1 Step -1
If Not IsNumeric(Mid(Micelda, i, 1)) And Mid(Micelda, i, 1) <>"," Then Mid(Micelda, i, 1) = " "
Next
Micelda = Trim(Micelda)
nCifra = Application.WorksheetFunction.Search(" ", Micelda)
.Cells(j, 2) = Trim(Mid(Micelda, 1, nCifra)) * 1
.Cells(j, 3) = Trim(Mid(Micelda, nCifra, 10000)) * 1
Next
End With
End Sub

Como podéis ver la macro nos permite extraer las dos cifras y colocarlas en celdas contiguas. Es decir, que en principio realiza todo lo que necesitamos.

Pero después de analizarlo detenidamente, concluyo que este código tiene limitaciones importantes, es decir: no contempla los números negativos, los puntos, que sean más de dos cifras las que debemos extraer, etc.

En efecto, si el lector necesitase extraer 3 cifras tendría un problema, de hecho tendría que definir un nuevo punto (nCifra) desde el cual extraer la cuarta cantidad. Esto se puede hacer, pero tenemos otras formas más eficientes para obtener la información.

Os voy a presentar una macro que he programado para extraer cualquier cantidad que se encuentre en una cadena de texto y que permite colocar esos datos en celdas contiguas. Pero primero vamos a ver los datos que queremos extraer:

EXTRAER INFORMACIÓN DE UNA CADENA DE TEXTO UTILIZANDO TEXTO EN COLUMNAS

Y ahora la vamos a ver la macro:

Sub Extrae_numeros()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer, fin As Integer
Dim nCampos As Integer, n_Colum As Integer
Dim miCelda As String
Dim miArray As Variant, iArray As Variant
'Iniciamos la macro
With Sheets("DATOS")
Application.ScreenUpdating = False
fin = Application.CountA(.Range("A:A"))
'Borramos información a partir de la columna "B"
.Range(.Cells(2, 2), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Iniciamos bucle para recorrar todas las filas
For j = 2 To fin
'Seleccionamos la fila
miCelda = .Cells(j, 1)
'Extraemos solo los números, los puntos, las comas y el signo - (si existen)
For i = Len(miCelda) To 1 Step -1
If Not IsNumeric(Mid(miCelda, i, 1)) And Mid(miCelda, i, 1) <> "," _
And Mid(miCelda, i, 1) <> "-" And Mid(miCelda, i, 1) <> "." Then Mid(miCelda, i, 1) = " "
Next
'Eliminamos espacios
miCelda = Trim(miCelda)
'Realizamos un segundo bucle y eliminamos todos los puntos, comas o signos - que aparezan antes de un
'carácter numérico
For n = Len(miCelda) To 1 Step -1
If Mid(miCelda, n, 1) = "," And Not IsNumeric(Mid(miCelda, n + 1, 1)) Then Mid(miCelda, n, 1) = " "
If Mid(miCelda, n, 1) = "." And Not IsNumeric(Mid(miCelda, n + 1, 1)) Then Mid(miCelda, n, 1) = " "
If Mid(miCelda, n, 1) = "-" And Not IsNumeric(Mid(miCelda, n + 1, 1)) Then Mid(miCelda, n, 1) = " "
Next
'Volvemos a eliminar espacios y ya tenemos la cadena de texto depurada.
.Cells(j, 2) = Trim(miCelda)
'Dimensionamos matrices con los datos que tenemos en miCelda
'para determinar las columnas de la función textToColumns
nCampos = Len(.Cells(j, 2))
nCampos = nCampos - 1
ReDim miArray(0 To nCampos)
For n_Colum = 0 To nCampos
ReDim iArray(0 To 1)
iArray(0) = n_Colum + 1
iArray(1) = 1
miArray(n_Colum) = iArray
Next n_Colum
'Aplicamos la función texto en columnas a partir de la segunda columna
'delimitamos el texto en caracteres (en este ejemplo utilizamos los espacios).
Cells(j, 2).TextToColumns Destination:=Range("B" & j), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, FieldInfo:=miArray
'Indicamos que todas las matrices tengan formato general, pero podríamos indicar que sea número, etc
Next
.Cells(j, 1).Select
End With
End Sub

Con esta macro, iniciamos varios procesos que debemos comentar (aunque ya lo indico en el código). En primer lugar necesitamos realizar dos bucles, en el primero eliminamos los caracteres no numéricos excepto los puntos, las comas y el signo -.

Por ejemplo, para la primera frase, después de aplicar el primer bucle, nos quedamos con estos datos en la variable “miCelda”:  24,5          1,5
Efectivamente, hemos eliminado los caracteres no numéricos y hemos dejado las comas y los números:

For i = Len(miCelda) To 1 Step -1
If Not IsNumeric(Mid(miCelda, i, 1)) And Mid(miCelda, i, 1) <> "," _
And Mid(miCelda, i, 1) <> "-" And Mid(miCelda, i, 1) <> "." Then Mid(miCelda, i, 1) = " "
Next

Pero en el segundo bucle, si tuviésemos por ejemplo, puntos o comas o guiones que no tienen que ver con números, por ejemplo un punto y seguido o una coma, los eliminaríamos, dejando solo dichos caracteres cuando están incluidos en números:

For n = Len(miCelda) To 1 Step -1
If Mid(miCelda, n, 1) = "," And Not IsNumeric(Mid(miCelda, n + 1, 1)) Then Mid(miCelda, n, 1) = " "
If Mid(miCelda, n, 1) = "." And Not IsNumeric(Mid(miCelda, n + 1, 1)) Then Mid(miCelda, n, 1) = " "
If Mid(miCelda, n, 1) = "-" And Not IsNumeric(Mid(miCelda, n + 1, 1)) Then Mid(miCelda, n, 1) = " "
Next

Una vez que tenemos los datos totalmente depurados, solo queda utilizar el texto en columnas para, precisamente, colocar cada número en la columna contigua.

Cells(j, 2).TextToColumns Destination:=Range("B" & j), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True

Y de esta forma ya tendríamos la macro totalmente finalizada, ya podríamos extraer las cifras en cada cadena de texto y colocarlas en las columnas que automáticamente generará la función texto en columnas y aplicando formato “general”.

Pero imaginad que queréis aplicar formato texto o formato de fecha a los datos que vayáis a extraer. Para poder hacer eso, debemos trabajar con matrices, dimensionando los campos a que vamos a pasar a cada columna y aprovechando para indicar el formato que queremos utilizar en cada uno de ellos:

nCampos = Len(.Cells(j, 2))
nCampos = nCampos - 1
ReDim miArray(0 To nCampos)
For n_Colum = 0 To nCampos
ReDim iArray(0 To 1)
iArray(0) = n_Colum + 1
iArray(1) = 1
miArray(n_Colum) = iArray
Next n_Colum

En este caso, el formato es general: iArray(1) = 1, si fuese texto, sería 2.

Por eso, ahora podemos especificar en el código “de texto en columnas” la información de los campos, es decir, podemos añadir que FielInfo sea igual a la matriz que hemos definido y dimensionado.

Cells(j, 2).TextToColumns Destination:=Range("B" & j), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, FieldInfo:=miArray

Para finalizar, este sería el resultado de aplicar la macro:

EXTRAER INFORMACIÓN DE UNA CADENA DE TEXTO UTILIZANDO TEXTO EN COLUMNAS1.jpg

Hemos extraído todas las cifras, conservando puntos, comas y signos negativos. El resto de información de la cadena de texto, simplemente la hemos omitido.

Si no necesitáis darle un formato específico a texto en columnas, podéis eliminar la parte de la macro que hace referencia a las matrices y el FielInfo de la función, aunque yo lo conservaría.

Y aunque seguro que llegarán otras consultas con nuevos planteamientos, creo que esta macro es válida para un amplio abanico de situaciones y necesidades.

Descarga el archivo de ejemplo pulsando en: EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA ALFANUMÉRICA UTILIZANDO TEXTO EN COLUMNAS

 

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

 

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").VisibleItems.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