EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS

Aunque normalmente no tengo mucho tiempo, a veces entro en algunos foros de Excel y contesto algunas de las preguntas que realizan los lectores. Esto es muy positivo, siempre encuentras nuevas ideas para desarrollar y hechas una mano a otras personas.

La última consulta que respondí iba sobre la posibilidad de extraer registros únicos pero no de una columna sino de un rango de datos. Es decir, seleccionar un rango de celdas y extraer los registros únicos.

Esta tarea se puede hacer de varias formas, en esta ocasión lo implementaré con matrices en VBA y finalmente aplicaremos quitar duplicados.

Como siempre vamos a usar un ejemplo: voy a pegar varias columnas (tres, por ejemplo) sobre las que seleccionaré el rango sobre el que extraer la información:

EXTRAER REGISTROS UNICOS DE UN RANGO DE DATOS1

A continuación debemos pegar la macro que realizará el trabajo:

Sub EXTRAER_UNICOS()
'Definimos variables
Dim i As Long, fin As Long
Dim rng As Range, celda As Range
Dim final As Long
Dim matriz() As Variant
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Trabajamos con la hoja activa
With ActiveSheet
'Limpiamos datos en la columna E
.Columns("E:E").ClearContents
'Capturamos selección y contamos registros
i = 1
Set rng = Selection
fin = rng.Count
'Redimensionamos la matriz
ReDim matriz(1 To fin)
'Con un loop grabamos los datos de cada celda
'y los pasamos a la columna E

For Each celda In rng
matriz(i) = celda.Value
i = i + 1
Next celda
For i = LBound(matriz) To UBound(matriz)
.Cells(i, 5) = matriz(i)
Next i
'Eliminamos duplicados de la columna E
final = .Cells(Rows.Count, "E").End(xlUp).Row
'Si no hay datos en la columna E salimos del proceso
If final = 1 Then Exit Sub
.Range("E1:E" & final).RemoveDuplicates Columns:=1, Header:=xlNo
'Ordenamos los datos, centrados y ascendentes
With .Columns("E:E")
.Select
.HorizontalAlignment = xlCenter
End With
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("E1:E" & final), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("E1:E" & final)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
.Range("E1").Select
End With
Application.ScreenUpdating = True
End Sub

Ahora que ya tenemos la macro, solo tenemos que seleccionar los datos y pulsar en el botón de comando. El resultado lo pasará a la columna “E” o “5” (podéis especificar el destino que mejor se adapte a vuestras necesidades indicándolo en el código).

Y ya tenemos los datos:

EXTRAER REGISTROS UNICOS DE UN RANGO DE DATOS2

Dado que estamos trabajando con matrices, debéis tener en cuenta que tienen ciertos límites (por ejemplo, si seleccionamos toda la hoja, mostrará un error).

Y eso es todo por hoy, espero que os sea de utilidad. Por supuesto, en este ejemplo obtenemos los datos de una selección, pero se podría definir un rango perfectamente.

Descarga el archivo de ejemplo pulsando en: EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS

Anuncios

GRABAR EL NOMBRE DE USUARIO DE WINDOWS CUANDO ABRIMOS Y CERRAMOS NUESTRO ARCHIVO EXCEL

Últimamente estoy recibiendo bastantes consultas, algunas son demasiado extensas como para realizar un ejemplo en un post, pero otras son perfectas para realizar un post.

La consulta que me enviaron ayer trata sobre la posibilidad de obtener el usuario de Windows con VBA y utilizarlo en una archivo compartido para identificar las personas que acceden (y también obtener la misma información en el momento que cierran en archivo).

Además aprovecho para agregar dos datos más a la información: la fecha y la hora.

En realidad son dos macros, una para la apertura y otra para el cierre. Para cuando abrimos el archivo, creo que lo que mejor se ajusta es grabar el código en ThisWorkbook  y utilizar el evento Open. La macro que debéis pegar es esta:

Private Sub Workbook_Open()
'Declaramos variables
Dim sNetwork As Object
Dim i As Integer, fin As Integer
'Obtenemos nombre del usuario del equipo
Set sNetwork = CreateObject("WScript.Network")
UserName = sNetwork.UserName
'Mostramos los datos en la Hoja1 al abrir el archivo
With Sheets("Hoja1")
fin = Application.CountA(Sheets("Hoja1").Range("A:A"))
For i = 2 To fin
If .Cells(i, 1) = "" Then
Final = i
Exit For
End If
Next
'Nombre de usuario
.Cells(i, 1) = UserName
'Fecha
.Cells(i, 2) = Date
'Hora
.Cells(i, 3) = Format(Time, "h:mm:ss")
'Indicamos que la acción es de apertura del archivo
.Cells(i, 4) = "ABRE ARCHIVO"
End With
'Liberamos variables
Set sNetwork = Nothing
End Sub

Con esta macro vamos a obtener la siguiente información:

GRABAR EL NOMBRE DE USUARIO DE WINDOWS CUANDO ABRIMOS Y CERRAMOS NUESTRO ARCHIVO EXCEL

Para grabar los datos con el cierre del archivo vamos a utilizar la siguiente macro:

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
'Declaramos variables
Dim sNetwork As Object
Dim i As Integer, fin As Integer
'Obtenemos nombre del usuario del equipo
Set sNetwork = CreateObject("WScript.Network")
UserName = sNetwork.UserName
'Mostramos los datos en la Hoja1 al cerrar el archivo
With Sheets("Hoja1")
fin = Application.CountA(Sheets("Hoja1").Range("A:A"))
For i = 2 To fin
If .Cells(i, 1) = "" Then
Final = i
Exit For
End If
Next
'Nombre de usuario
.Cells(i, 1) = UserName
'Fecha
.Cells(i, 2) = Date
'Hora
.Cells(i, 3) = Format(Time, "h:mm:ss")
'Indicamos que la acción es de apertura del archivo
.Cells(i, 4) = "CIERRA EXCEL"
End With
'Liberamos variables
Set sNetwork = Nothing
ActiveWorkbook.Save
End Sub

Aquí vamos a utilizar el evento Workbook_WindowDeactivate y además, guardaremos el archivo desactivando con ActiveWorkbook.Save, este es el resultado:

GRABAR EL NOMBRE DE USUARIO DE WINDOWS CUANDO ABRIMOS Y CERRAMOS NUESTRO ARCHIVO EXCEL1

Obviamente, si abrimos y cerramos varias  veces el archivo tendremos varios registros indicando nuestra actividad.

El archivo os lo dejo en blanco, de manera que cuando lo abráis aparecerán vuestros datos grabados en la Hoja1 del archivo. El archivo se puede cambiar a compartido si es necesario, las macros funcionarán perfectamente (probado en Excel 2010 y Excel 2016).

Espero que sea de vuestro interés 🙂

Descarga el archivo de ejemplo pulsando en: GRABAR EL NOMBRE DE USUARIO DE WINDOWS CUANDO ABRIMOS Y CERRAMOS NUESTRO ARCHIVO EXCEL

 

VERIFICAR EL ESTADO DE LOS ENLACES A OTROS ARCHIVOS DESDE NUESTRO PROYECTO

Hola a todos:

Esta semana un lector me enviaba la siguiente consulta: Se trata de cómo se podría verificar en un archivo si los vínculos con otros archivos, utilizados en fórmulas, referencias, etc, son correctos y no se han eliminado o modificado.

Este es un tema muy recurrente cuando trabajamos con Excel y en entornos en los que compartimos archivos y datos con otros compañeros. Es posible que por error alguien elimine un archivo que está vinculado a nuestro proyecto y no nos demos cuenta hasta que sea demasiado tarde.

Pues bien, para estos casos en concreto, para poder ver e identificar los archivos vinculados y su estado, se puede realizar con VBA un pequeño proceso que extraiga esta información.

Pero antes vamos a desarrollar un ejemplo. Imaginad que tenemos un archivo con los siguientes ID’s y nombres de campo:

VERIFICAR EL ESTADO DE LOS ENLACES A OTROS ARCHIVOS DESDE NUESTRO PROYECTO

y además una serie de archivos donde se almacena la información por tipo de campo:

VERIFICAR EL ESTADO DE LOS ENLACES A OTROS ARCHIVOS DESDE NUESTRO PROYECTO2

Dado que tenemos que componer nuestra base de datos con la información del resto de archivos, vamos a utilizar la función Buscarv() para traernos la información.

Una vez que la tenemos, el resultado es el siguiente:

VERIFICAR EL ESTADO DE LOS ENLACES A OTROS ARCHIVOS DESDE NUESTRO PROYECTO3

Como podéis ver, las fórmulas funcionan correctamente y los vinculos no contienen errores. Pero resulta que un compañero de nuestro equipo, por equivacación, ha eliminado el archivo que contiene los nombres y, por si fuese poco, otra compañera ha eliminado la hoja del archivo “ASIGNATURAS” que contenía los datos.

Así se presentaría nuestra información una vez que abrimos el archivo. (en el caso de las hoja eliminada al principio nos aparecerá un error de referencia #¡REF! y al evaluar el error se convertirá en #N/A). Pero en el caso de los nombres no nos vamos a dar cuenta, dado que Excel se queda con el valor anterior.

Para realizar el control en nuestro archivo, utilizaremos la siguiente macro:

Sub VERIFICAR_LINKS_EXTERNOS()
'Declaramos variables
Dim i As Integer, infoLink As Integer
Dim eLinks As Variant
Dim MsgLnk As String
Dim fin As Integer
'Borramos datos en Hoja Resumen
Sheets("RESUMEN").Select
With Sheets("RESUMEN")
fin = Application.CountA(.Range("A:A"))
If fin > 1 Then .Range("A2:B" & fin).ClearContents
End With
'si no existen referencias a otros archivos salimos del proceso
eLinks = ThisWorkbook.LinkSources(xlExcelLinks)
If IsEmpty(eLinks) Then
MsgBox ("NO EXISTEN LINK EXTERNOS EN EL LIBRO")
Exit Sub
End If
'Con un bucle verificamos el estado de cada link e identificamos
'su estatus
For i = 1 To UBound(eLinks)
infoLink = ActiveWorkbook.LinkInfo(eLinks(i), xlLinkInfoStatus)
If infoLink = xlLinkStatusMissingFile Then
MsgLnk = "Falta el archivo de origen"
ElseIf infoLink = xlLinkStatusMissingSheet Then
MsgLnk = "Falta la hoja del archivo de origen"
ElseIf infoLink = xlLinkStatusCopiedValues Then
MsgLnk = "Valores copiados"
ElseIf infoLink = xlLinkStatusIndeterminate Then
MsgLnk = "No se puede determinar el estado"
ElseIf infoLink = xlLinkStatusInvalidName Then
MsgLnk = "El nombre no es válido"
ElseIf infoLink = xlLinkStatusNotStarted Then
MsgLnk = "No iniciado"
ElseIf infoLink = xlLinkStatusOld Then
MsgLnk = "El estado puede no estar actualizado"
ElseIf infoLink = xlLinkStatusSourceNotCalculated Then
MsgLnk = "No se ha calculado todavía"
ElseIf infoLink = xlLinkStatusSourceNotOpen Then
MsgLnk = "El documento de origen no está abierto"
ElseIf infoLink = xlLinkStatusSourceOpen Then
MsgLnk = "El documento de origen está abierto"
ElseIf infoLink = xlLinkStatusOK Then
MsgLnk = "Sin errores"
End If
'Pasamos los datos a la hoja RESUMEN
With Sheets("RESUMEN")
.Cells(1, 1) = "RUTA ARCHIVO"
.Cells(1, 2) = "MENSAJE"
.Cells(i + 1, 1) = eLinks(i)
.Cells(i + 1, 2) = MsgLnk
End With
'Mostramos datos en la ventana de Inmediato en nuestro editor de VBA
Debug.Print "Ruta = "; eLinks(i) & " | Mensaje = "; MsgLnk
Next
End Sub

El resultado es el siguiente:

VERIFICAR EL ESTADO DE LOS ENLACES A OTROS ARCHIVOS DESDE NUESTRO PROYECTO4

En aquellos casos que o bien han eliminado el archivo o una hoja, tenemos información precisa de lo que ha ocurrido y a que archivos afecta. En el resto de casos nos encontraremos con que no hay errores, aunque es posible que si lleváis tiempo sin ejecutar abrir el archivo (lo cual es muy probable), si ejecutáis la información en el momento de abrir, os aparezca el mensaje “El estado puede no estar actualizado“, lo cual indica que es aconsejable actualizar las fórmulas.

Al final de la macro os dejo la posibilidad de ver la misma información en la ventana de Inmediato de vuestro editor de VBA, por si no queréis utilizar la hoja “Resumen”.

He decido poner en la macro, todos los mensajes posibles que Excel puede mostrar, aquí tenéis información sobre este tema: https://msdn.microsoft.com/es-es/library/office/ff196932.aspx

Espero que os resulte de utilidad a la hora de verificar qué archivos están dando problemas o simplemente si todo nuestro trabajo está correctamente vinculado.

Saludos.

PD: cuando ejecutéis la macro en vuestro equipo, el mensaje será para todos los casos “Falta el archivo de origen”, dado que, como es obvio esos archivos están en mi equipo 🙂

Descarga el archivo de ejemplo pulsando en: VERIFICAR EL ESTADO DE LOS ENLACES A OTROS ARCHIVOS DESDE NUESTRO PROYECTO

 

VACIAR TODOS LOS COMBOBOX DE UNA HOJA

Hola a todos:

Hoy escribiré sobre cómo podemos automatizar la tarea de vaciar todos los combobox de nuestra hoja.

Dado que es un ejemplo sencillo no dejaré archivo, con el código es suficiente. Tan solo tenéis que copiarlo y pegarlo en un módulo estándar y realizar la prueba:

Sub VACIAR_COMBOS()
With ActiveSheet
'Por cada objeto que sea un combobox limpiamos contenido
For Each objeto In .OLEObjects
If objeto.OLEType = xlOLEControl Then
If TypeName(objeto.Object) = "ComboBox" Then
objeto.Object.Clear
End If
End If
Next
End With
End Sub

Como podéis ver, lo único que hacemos es pasar un “for – each” por todos los objetos de la hoja y cuando se trata del tipo especificado, limpia o vacía el contenido.

Es una macro sencilla y si tenéis aplicaciones que requieren  vaciar todos los combos, podéis hacerlo muy rápido con este código.

Si tuviésemos listbox en lugar de combobox, solo tendréis que sustituir listbox por combobox en la macro:

Sub VACIAR_LISTBOX()
With ActiveSheet
'Por cada objeto que sea un listbox limpiamos contenido
For Each objeto In .OLEObjects
If objeto.OLEType = xlOLEControl Then
If TypeName(objeto.Object) = "ListBox" Then
objeto.Object.Clear
End If
End If
Next
End With
End Sub

Y ya para finalizar, si se tratase de TextBox, solo hemos de modificar el método de limpiar los datos:

Sub VACIAR_TEXTBOX()
With ActiveSheet
'Por cada objeto que sea un textbox limpiamos contenido
For Each objeto In .OLEObjects
If objeto.OLEType = xlOLEControl Then
If TypeName(objeto.Object) = "TextBox" Then
objeto.Object = ""
End If
End If
Next
End With
End Sub

Son pequeñas “pinceladas” que os pueden ser de mucha utilidad para hacer que vuestro código sea más corto y más eficiente.

Y eso es todo por hoy.

Saludos! 🙂

RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR

Hoy voy a tratar un tema que, aunque pueda parecer menor, no es la primera vez que me lo encuentro cuando realizo trabajos o informes.

El problema surge cuando trabajamos con datos de una tabla dinámica que han sido pegados en una hoja como valores y es necesario rellenar las filas en blanco con el dato de la celda superior que contenga información.

Un ejemplo podría ser este:

RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR

Es decir, en aquellas celdas que se encuentran en blanco rellenarlas con el dato correspondiente, licenciado, diplomado, etc.

Para hacer este trabajo, podemos hacerlo o bien con macros o bien utilizando funciones de la hoja Excel.

Si queremos hacerlo manualmente con funciones:  nos posicionamos en una celda de la columna que contiene las celdas en blanco, a continuación, (sin dejar de seleccionar la celda), vamos a la pestaña de INICIO > BUSCAR Y SELECCIONAR > IR A ESPECIAL:

RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR2

y marcamos la opción “Celdas en Blanco“:

RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR3

Ahora que tenemos las celdas en blanco seleccionadas, (y deben seguir seleccionadas):

RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR4

Nos situamos en la barra de fórmulas y tecleamos =A2 que se corresponde con la última fila con datos y pulsamos CONTROL + INTRO.

RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR5

El resultado es el siguiente:

RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR6

Pero si por alguna razón necesitamos realizar esta tarea con una macro, por ejemplo para automatizar un proceso, lo podemos hacer con dos métodos diferentes, que en realidad hacen lo mismo.

La primera macro (METODO1) realiza los mismos pasos que hemos hecho manualmente, y además deja los datos como valores, sin la fórmula:

Sub Metodo1()
'Defininimos variables
Dim Fin%, x%, Rng%
With Sheets("Hoja1")
'Grabamos longitud del rango y contamos celdas en blanco
Fin = Application.CountA(.Range("B:B"))
x = WorksheetFunction.CountBlank(Range("A2:A" & Fin))
'Si hay celdas en blanco
If x > 0 Then
'Seleccionamos celdas en blanco
.Range("A2:A" & Fin).SpecialCells(xlCellTypeBlanks).Select
'Aplicamos fórmula en cada celda, hace referencia al valor anterior
Selection.FormulaR1C1 = "=R[-1]C"
'Seleccionamos todo el rango y lo pasamos a valores
Rng = Application.CountA(.Range("A:A"))
.Range("A2:A" & Rng).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End With
End Sub

La segunda macro (METODO2) es mucho más sencilla y realiza el trabajo mediante un loop haciendo referencia a la última celda con datos:

Sub Metodo2()
'Definimos variables
Dim i%, Fin%
With Sheets("Hoja2")
Fin = Application.CountA(.Range("B:B"))
'Mediante un bucle indicamos que si una celda está vacía
'el valor sea el de la celda anterior.

For i = 2 To Fin
If .Cells(i, 1) = "" Then .Cells(i, 1) = .Cells(i - 1, 1)
Next
End With
End Sub

Con las dos códigos obtendremos el mismo resultado. También debemos tener en cuenta la primera opción (manual) que para casos concretos es la más rápida y eficaz.

Descarga el archivo de ejemplo pulsando en: RELLENAR RANGO DE CELDAS VACÍAS CON EL VALOR DE LA CELDA SUPERIOR

EJECUTAR UN BUCLE EN UN RANGO DE FILAS FILTRADAS

Hola a todos!.

Hace unos días, un lector me trasladó la pregunta de cómo podría ejecutar un bucle (loop) en un rango de filas filtradas. Esto se puede realizar de diferentes formas, pero para este post quiero aprovechar y realizar un ejercicio completo con un caso práctico.

Imaginad que trabajáis de un teatro y se ha decido que para una función concreta, la asignación de sitios en las diferentes zonas del teatro se hará de una manera determinada:

Nos han enviado un listado (hoja LISTA) en el que aparecen los siguientes campos ID, FECHA, HORA, NOMBRE y LUGAR (zona del teatro), esta es la lista:

EJECUTAR UN BUCLE EN UN RANGO DE FILAS FILTRADAS

Pues bien, lo que se pretende es que asignemos un 50% de la cantidad total del número de solicitudes a cada zona y teniendo en cuenta la fecha más antigua y la hora más antigua de cada petición. Es decir que si el número total de personas que han solicitado un lugar en la Zona Premium es de 122 se marcarán los 61 primeros registros teniendo en cuenta la fecha más antigua y la hora más antigua como criterio.

Para hacer este proceso es necesario realizar varios filtros y posteriormente marcar a los clientes beneficiados. Obviamente, se puede hacer manualmente, pero … ¡el tiempo es oro! y no es cuestión de estar varias horas haciendo este proceso, o lo que es peor, imaginad que a partir de ahora siempre se hará así!.

Por lo tanto, vamos a proponer un sencillo código que nos va a ayudar a realizar esto en un segundo 🙂

Antes de ver la macro, debemos añadir otra hoja en la que vamos a indicar el nombre de todas las zonas del teatro:

EJECUTAR UN BUCLE EN UN RANGO DE FILAS FILTRADAS2

Y ahora, en un módulo estándar pegáis esta macro:

Sub BUCLE_EN_CELDAS_FILTRADAS()
'Definimos variables
Dim Fin As Integer, Final As Integer, nCasos As Integer
Dim nRango As Range, Contador As Integer, n As Integer, Dato As Range
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Limpiamos contenidos en el campo MARCA
With Sheets("LISTA")
Fin = Application.CountA(.Range("A:A"))
Final = Application.CountA(Sheets("ZONAS").Range("A:A"))
If Fin > 1 Then .Range("F2:F" & Fin).ClearContents
'Iniciamos bucle filtrando según ZONA y aplicando el 50 al total de personas
'con esta cifra marcaremos con otro bucle los n casos iniciales

For i = 2 To Final
'Pero antes, ordenamos por fecha, de más antigua a más reciente
nCasos = Round(Application.WorksheetFunction.CountIf(.Range("E2:E" & Fin), Sheets("ZONAS").Cells(i, 1)) * 0.5, 0)
.Range("A1:E" & Fin).AutoFilter Field:=5, Criteria1:=Sheets("ZONAS").Cells(i, 1)
With ActiveWorkbook.Worksheets("LISTA").AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B1:B" & Fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.Header = xlYes
.Apply
End With
'Ordenamos hora, de más antigua a más reciente
With ActiveWorkbook.Worksheets("LISTA").AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("C1:C" & Fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.Header = xlYes
.Apply
End With
'Pasamos un segundo bucle para marcar con una X el 50% de los casos seleccionados
Set nRango = .Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
For Each Dato In nRango.Rows
n = 1
Contador = Contador + n
If Contador <= nCasos Then
Dato.Cells(1, 6).Value = "X"
Else
Exit For
End If
Next
Contador = 0
Selection.AutoFilter
Next
End With
'Ordenamos por ZONA y mostramos la información
Range("A1").Select
Selection.AutoFilter
With ActiveWorkbook.Worksheets("LISTA").AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("E1:E" & Fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.Header = xlYes
.Apply
Selection.AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Como podéis observar, realizamos dos tipo de bucle, un for-next y un for each – next. Pero es este último (for each) en el que realmente pasamos un bucle sobre las celdas que hemos filtrado previamente según los parámetros establecidos en los datos del primer bucle.

Pulsamos el botón y tenemos este resultado:

EJECUTAR UN BUCLE EN UN RANGO DE FILAS FILTRADAS3

El código se encarga de filtrar, marcar y presentar los datos ordenador por zonas. En solo un segundo (para 800 registros).

Creo que es un ejercicio muy interesante y que podéis aplicar a multitud de tareas y proyectos. 🙂

Como siempre os dejo el archivo de descarga:

Descarga el archivo de ejemplo pulsando en: EJECUTAR UN BUCLE EN UN RANGO DE FILAS FILTRADAS

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3: ANÁLISIS DE LOS DATOS

Hola a todos!. Espero que todo vaya bien 🙂

Hoy vamos a seguir con la serie de post dedicados a trabajar con grandes bases de datos en Excel. Y en esta ocasión hablaremos sobre el análisis de la información.

Al igual que en las dos partes anteriores, usaremos los datos que estamos usando como ejemplo: Encuesta Europea de Salud en España y los dos post anteriores que podéis consultar son los siguientes:

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 1: IMPORTAR LA INFORMACIÓN

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 2: EXTRAER LA INFORMACIÓN

Bien, siguiendo con nuestros ejercicios, llegamos al momento de buscar y obtener información relevante y útil en los datos, es decir, al análisis de la información.

Ni que decir tiene, que aquí podemos aplicar cientos de técnicas, cada una con indicadores y métodos diferentes. Así que voy a elegir una función para realizar un ejemplo complejo de obtener información y mostrarla con gráficos.

La función que voy a desarrollar en VBA es el Coeficiente de Correlación que como veremos, nos va a servir para comprobar si existe relación entre dos variables, y a su vez determinar el tipo de relación (si existe). Esta función necesita 2 matrices (variables) para poder ser calculada, y en nuestro ejemplo, me ha parecido interesante usar la edad y “Consumo de tabaco”, ambas variable se corresponden en nuestros datos con EDADa Y V121 respectivamente.

Una vez que hemos extraído la información seleccionando los datos en el listbox de la primera hoja, tendremos la siguiente información en la hoja “QUERY” y vamos a aprovechar para añadir otra hoja y nombrarla como “CORRELACIONES”.

Ahora que tenemos la estructura preparada, vamos a incluir esta serie de macros en un módulo estándar. Son varias macros, pero en realidad ejecutamos la primera, dado que realizamos varios “Call” al resto de macros. Creo que así se comprende de forma más clara la funcionalidad del código.

Se trata de una macro con cierto nivel de complejidad, así que la iremos viendo poco a poco, estas son las macros:

En primer lugar vamos a ejecutar esta macro que en su proceso va a llamar (“Call”) a otras macros para completar toda la instrucción. Es la macro principal que realiza una conexión ADO y obtiene ordenamos los datos para poder aplicar el coeficiente de correlación entre las diferentes variables.

Sub CONEXION_SQL_CORRELACION()
'Declaramos variables
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection
Dim Fin As Integer, Final As Integer, i As Integer, j As Variant, Comodin As String
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Eliminamos datos de correlaciones anteriores
Sheets("CORRELACIONES").Select
With Sheets("CORRELACIONES")
'Eliminamos imágenes y correlaciones anteriores
Call ELIMINAR_IMAGENES
'Creamos variable para conocer el número más alto del rango indicado
Final = Application.WorksheetFunction.Max(Sheets("QUERY").Range("B:B"))
'Creamos un bucle para generar tantas consultas SQL como máximo sea el rango.
For j = 1 To Final + 1
'Creamos un caracter comodín para mostrar todos los items.
Comodin = "'%" & "%'"
'Cuando superemos el máximo de valores, el valor +1 será el comodín
If j = Final + 1 Then j = Comodin
'Eliminamos datos de la consutla SQL anterior
Fin = Application.CountA(.Range("A:A"))
If Fin > 0 Then .Range("A2:C" & Fin).ClearContents
'Realizamos consulta SQL, en este caso son dos variables, la edad y el habito de fumar según varias preguntas
obSQL = "SELECT [QUERY$].[EDADa], [QUERY$].[V121], COUNT ([QUERY$].[V121]) AS CUENTA " & _
"FROM [QUERY$] " & _
"WHERE [QUERY$].[V121] like " & j & " " & _
"GROUP BY [QUERY$].[EDADa], [QUERY$].[V121] " & _
"ORDER BY [QUERY$].[V121]"
MiLibro = ActiveWorkbook.Name
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
'Grabamos la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
'Pegamos datos y añadimos encabezados
Do Until Dataread.EOF
Dataread.MoveFirst
.Cells(2, 1).CopyFromRecordset Dataread
For i = 0 To Dataread.Fields.Count - 1
Tit = Dataread.Fields(i).Name
.Cells(1, i + 1) = Tit
Next
Loop
'Si el caracter no es el comodín, realizamos la correlación de los datos
If j <> Comodin Then
Call CORRELACION
End If
'Indicamos que no se muestre el error cuando pasamos la variable string

'en el último ciclo del bucle

On Error Resume Next
Next
On Error GoTo 0
'liberamos y desconectamos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
'Movemos las imagenes a la altura de la celda M3
.Pictures.Select
Selection.ShapeRange.IncrementTop -368
.Range("M3").Select
End With
Application.ScreenUpdating = True
End Sub

Con esta macro, realizamos la correlación entre la edad y cada pregunta realizada sobre la frecuencia de consumo de tabaco. Se ejecuta con la macro CONEXION_SQL_CORRELACION.

Sub CORRELACION()
'Definimos variables
Dim CORRELACION As Double, D As Integer, A As Integer
Dim i As Integer, Fin As Integer, Final As Integer
With Sheets("CORRELACIONES")
Final = Application.WorksheetFunction.Max(Sheets("QUERY").Range("B:B"))
Fin = Application.CountA(.Range("A:A"))
.Cells(1, 5) = "ID"
.Cells(1, 6) = "CORRELACION"
.Cells(1, 7) = "R2"
'Con un bucle realizamos la correlación hasta el máximo de rango indicado en "Final"
For i = 1 To Final
'Evitamos errores cuando con los datos no sea posible extraer correlación
On Error Resume Next
CORRELACION = Application.WorksheetFunction.Correl(.Range("A2:A" & Fin), .Range("C2:C" & Fin))
On Error GoTo 0
'Mostramos ID (pregunta de la encuesta)
'Mostramos correlación

If .Cells(2, 2) = i Then
D = Application.CountA(.Range("E:E"))
A = D + 1
.Cells(A, 5) = .Cells(2, 2)
.Cells(A, 6) = CORRELACION
'Generamos gráficos
Call GRAFICO_IMAGEN
End If
Next
End With
End Sub

Desde la macro anterior llamamos a esta otra macro, que generará cada gráfico después de haber realizado cada correlación por Item. Una vez realizado el gráfico, se pasa a imagen y se borra el gráfico. Se ejecuta con la macro “CORRELACION”

Sub GRAFICO_IMAGEN()
'Declaramos variables
Dim D As Integer, X As Double, nITEM As String, r2 As Double
Dim id1 As String, id2 As String
With Sheets("CORRELACIONES")
'Generamos gráficos de dispersión, los configuramos
'y los pasamos a imagenes y eliminamos el gráfico.
D = Application.CountA(.Range("E:E"))
X = Round(D * 30 / 2, 0)
.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Range("A:A,C:C")
.ChartObjects.Width = 320
.ChartObjects.Height = 190
'Adaptamos el tipo de puntos en la nube de puntos y tamaño
With ActiveChart.SeriesCollection(1)
.Select
Selection.MarkerStyle = 8
Selection.MarkerSize = 3
ActiveChart.PlotArea.Select
.Trendlines.Add
.Trendlines(1).Select
Selection.DisplayEquation = True
Selection.DisplayRSquared = True
Selection.NameIsAuto = True
'Seleccionamos línea de tendencia Polinomial
'de grado 3, que es el que mejor se ajusta
'a nuestros datos
With Selection
.Type = xlPolynomial
.Order = 3
End With
'Movemos la fórmula y R2 arriba a la derecha
.Trendlines(1).DataLabel.Select
Selection.Left = 178
Selection.Top = 34
End With
'Eliminamos lineas divisorias horizontales
ActiveChart.Axes(xlValue).MajorGridlines.Select
Selection.Delete
'Nombramos el gráfico
nITEM = .Cells(2, 2)
ActiveChart.ChartTitle.Text = nITEM
'Obtenemos Rcuadrado y se aplicamos su raiz cuadrada para
'obtener la correlación correcta

W = ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text
id1 = InStr(W, "R²")
id2 = InStr(id1, W, "=")
r2 = Trim(Mid(W, id2 + 1))
Sheets("CORRELACIONES").Cells(D, 7) = Round(r2, 2)
'Pasamos el gráfico a imagen
.ChartObjects(1).Activate
Application.CutCopyMode = False
ActiveChart.ChartArea.Copy
.Range("M" & X).Select
.Pictures.Paste.Select
.ChartObjects(1).Delete
End With
End Sub

Con esta macro eliminamos todas las imágenes de tipo “Picture” en la hoja. Se ejecuta con la macro CONEXION_SQL_CORRELACION.

Sub ELIMINAR_IMAGENES()
Dim Shape As Excel.Shapes, Fin As Integer
'Eliminamos todas las imagenes de la hoja CORRELACIONES
With Sheets("CORRELACIONES")
Fin = Application.CountA(.Range("A:A"))
For Each Shapes In .Shapes
With Shapes
If .Type = 13 Then
.Delete
End If
End With
Next
If Fin > 0 Then .Range("E2:G" & Fin).ClearContents
End With
End Sub

En rojo os he marcado aquellas macros que ejecutamos con un procedimiento “Call”. Imaginad que incorporamos todas las macros en una sola (sería demasiado confuso).

Recordamos las preguntas de la encuesta sobre hábitos y consumo de tabaco:

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3 ANALISIS DE LOS DATOS

Pues bien, este es el resultado de realizar la correlación y generar los gráficos de puntos (pulsad en el gráfico para hacer zoom en la imagen)

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3 ANALISIS DE LOS DATOS2

Como podéis observar, en los casos 1, 2, 3 y 4 existe una relación entre ambas variables, NO es una relación lineal (tal y como podéis ver) y además el R cuadrado que mostramos en el gráfico NO se corresponde con la correlación obtenida cuando hemos aplicado el coeficiente de Correlación.

Por lo tanto, si bien podemos apreciar que existe relacion entre las 4 primeras preguntas, no se puede tener como referencia el coeficiente de correlación que hemos calculado en la columna “CORRELACIÓN”, dado que los datos no son lineales y, por ejemplo, en la primera pregunta vemos una correlación de -0.45 cuando la correlación debería ser muy superior.

Para poder obtener la relación correcta, deberíamos calcular la “Razón de Correlación” que se aplica a relaciones no lineales, en este caso curvilíneas. Pero si os habéis fijado, en cada uno de los gráficos tenemos, por una parte la fórmula utilizada para calcular la nube de puntos y por otra el Coeficiente de Determinación o R cuadrado.

R2 es un índice estadístico que establece una medida del grado de asociación lineal entre la variable dependiente y la variable independiente, concretamente entre la variable dependiente y la recta de regresión estimada (o en este caso, la curva de regresión estimada).

Teniendo esto en cuenta y dado que el coeficiente de correlación que hemos calculado no podemos tenerlo en cuenta porque que se trata de datos no lineales, utilizaremos como índice estadístico el R2 para explicar los gráficos. En el primer gráfico, que se corresponde con la primera respuesta “SÍ, FUMO A DIARIO”. Podemos observar como R2 es de un 90% y podemos ver como la nube de punto se agrupa en torno a la línea de tendencia.

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3 ANALISIS DE LOS DATOS_PRIMERA PREGUNTA
Según este gráfico, podemos establecer que los casos de personas que afirman fumar todos los días aumentan a medida que su edad aumenta, pero descienden a medida que la edad pasa de un determinado umbral, (a partir de los 70 años).

En el segunda gráfico nos encontramos con que la nube de puntos no está tan cohesionada entorno a la linea de tendencia, también nos lo indica R2 con un 77%.

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3 ANALISIS DE LOS DATOS_SEGUNDA PREGUNTA
Aquí la respuesta es de “SÍ FUMO, PERO NO A DIARIO”, aunque nos encontramos en que el número de casos en determinadas edades rompe con la tendencia y aleja los puntos. Es decir, que en algunos casos la edad no puede explicar que una persona fumara antes y ahora no lo haga (existen otras variables que pueden explicar esto: enfermedades, percepción social … etc. Aunque la relación entre variables es significativa.

En la tercera pregunta, volvemos a los índices de la primera pregunta, R2 es de un 90% (podemos comprobarlo en el gráfico).

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3 ANALISIS DE LOS DATOS_TERCERA PREGUNTA

La respuesta es, “NO FUMO ACTUALMENTE, PERO HE FUMADO ANTES”. Se trata de ex fumadores, de nuevo la mayor cantidad de casos se encuentra en edades centrales, siendo en las edades “extremas” donde se encuentra el menor número de casos.

En el caso de la cuarta respuesta, “NO FUMO NI HE FUMADO NUNCA DE MANERA HABITUAL”.

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3 ANALISIS DE LOS DATOS_CUARTA PREGUNTA

Existe una menor relación entre ambas variables, es decir, que la edad no explicar de forma rotunda que las personas no fumen ni hayan fumado, es decir, existen otras variables que explicarían esta respuesta respecto al hábito de fumar.

Para los casos 8 y 9, NO SABE y NO CONTESTA aunque hemos calculado la correlación, R2 y el gráfico, no son representativos estadísticamente, y no los tendremos en cuenta.

Finalmente sacaremos de cada gráfico el dato de los coeficientes de determinación y los pondremos al lado de las correlaciones que hemos calculado y que no nos sirven.

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. PARTE 3 ANALISIS DE LOS DATOS3

Podríamos obtener la misma información, pero introduciendo los datos de hábitos de alcohol (o cualquier otra temática). No he automatizado la parte en la que obtenemos la información y generamos los gráficos y las correlaciones, si decidís actualizar otra información, debéis indicarlo en la cadena SQL:

obSQL = "SELECT [QUERY$].[EDADa], [QUERY$].[V121], COUNT ([QUERY$].[V121]) AS CUENTA " & _
"FROM [QUERY$] " & _
"WHERE [QUERY$].[V121] like " & j & " " & _
"GROUP BY [QUERY$].[EDADa], [QUERY$].[V121] " & _
"ORDER BY [QUERY$].[V121]"

Y en esta parte podríamos seguir jugando con otros indicadores estadísticos, otras técnicas, otros datos, etc. Pero creo que como ejemplo es suficiente.

Podríamos establecer nuevas variables independientes que nos ayuden a entender la relación, como el cambio de percepción de este tipo de hábito, las enfermedades, el gasto, etc, que sin ninguna duda juntas, explicarían el numero de casos por edad en cada pregunta. Pero como podéis ver, ¡esta investigación no ha hecho más que empezar!!

Pueden parece macros demasiado complejas, pero en realidad no lo son, si observáis los procesos con detenimiento podréis visualizar perfectamente el funcionamiento de la macro.

Interesante el proceso para obtener el R2 de los gráficos, también la utilización de la correlación como primera alternativa (que en caso de ser una relación lineal serviría perfectamente).

He dejado el archivo TXT importado en el Excel por eso tiene 18 mb. Para obtener el TXT solo tenéis que visitar alguno de los post anteriores.

Descarga el archivo de ejemplo pulsando en: TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL. ANÁLISIS DE LA INFORMACIÓN