GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES EN VBA

Hola a todos!.

Espero que estéis pasando unos buenos días de descanso durante este puente de la Constitución!.

Hoy ha decidido escribir un pequeño post sobre los patrones numéricos y una forma de generar uno en particular. Se trata del siguiente (aunque puede tener muchas variaciones): 123 212 321 o lo que es lo mismo pero visualmente en Excel:

GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES EN VBA

Podéis verlo perfectamente, y además me he permitido utilizar el formato condicional para colorear el área, generando así una secuencia mucho más visual, fijaros en el número 1, (verde) cómo se repita y cruza la diagonal. Esto lo podremos hacer de distintos tamaños, por ejemplo, de 20X20:

GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES EN VBA_1

Y ¿cómo generamos este patrón?, aquí el código:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Declaramos variables
Dim Mensaje As String, Titulo As String, MiArea As Variant
Dim i As Long, j As Long, celda As String
'Con un inputbox determinamos las dimensiones de nuestro cubo
Mensaje = "Introduce un número que será el alto y ancho del cubo que vamos a crear, por ejemplo el 20 para ser 20X20"
Titulo = "AREA DEL CUBO"
MiArea = InputBox(Mensaje, Titulo)
If StrPtr(MiArea) = 0 Then Exit Sub
'Mediante dos bucles anidados generamos una matriz de dos dimensiones
'que realizará la inversión de los dígitos generados en la primera columna
ReDim MiRango(0 To MiArea, 0 To MiArea)
MiRango(0, 0) = 1
For i = 1 To MiArea
MiRango(i, 0) = MiRango(i - 1, 0) + 1
MiRango(0, i) = MiRango(0, i - 1) + 1
For j = 1 To MiArea
MiRango(i, j) = MiRango(i - 1, j - 1)
MiRango(j, i) = MiRango(j - 1, i - 1)
Next j
Next i
'Pasamos los datos desde la celda activa con dobleclick
celda = ActiveCell.Address
Range(celda).Resize(MiArea, MiArea).Value = MiRango
End Sub

Como podéis observar utilizamos una matriz de dos dimensiones (necesaria) para crear esta secuencia, dado que necesitamos tener en cuenta filas y columnas. Las matrices se rellenan mediante dos loop anidados e incrementando +1 en cada fila y columna.

Podemos modificarlos y multiplicarlo por 2, por 3 etc o hacerlo en las diagonales (j) y el patrón sería distinto.

Para que no tengáis que ir modificando el área del cubo, os he creado en la macro un inputbox para indicarlo antes de pasar los datos a la hoja.

Y esto es todo, este es un ejercicio para que veais no solo cómo se puede crear este patrón, sino como podemos rellenar y generar una matriz bidimensional y (importate), pasarla a la hoja.

Descarga el archivo de ejemplo pulsando en: GENERAR UN PATRÓN NUMÉRICO CON MATRICES BIDIMENSIONALES EN VBA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

Hola a todos!:

Estos días estoy más liado de lo normal!, de repente se ha vuelto todo muchas … Intenso!. En fin, hay temporadas más tranquilas y otras con más trabajo, así es la vida.

Pero no por eso voy a dejar de publicar el post semanal de Excel y VBA, verdad?. Esta temporada estoy subiendo muchos vídeos de ejemplo de mis post a LinkedIn para que los usuarios de la red vean cómo funciona realmente un procedimiento o una fórmula.

Hoy quiero compartir una de tantas formas que existen para crear y colocar encabezados en nuestros informes. Desde la igualación de celdas a un valor a un proceso  mediante un loop o igualando un rango a un array.

Este último ejemplo es el que vamos a ver hoy, y es muy sencillo: Imaginad que queréis mostrar siempre este encabezado en la hoja que se esté activa:

COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

Para conseguirlo, lo vamos a hacer con 5 líneas de código:

Sub ENCABEZADOS()
With Range("A1:F1")
.Value = Array("NOMBRE", "APELLIDOS", "EDAD", "ESTUDIOS", "TELÉFONO", "DIRECCIÓN")
.Font.Bold = True
.Font.Color = vbRed
End With
End Sub

Como podéis ver,  no hemos usado una sola variable, simplemente hemos definido el rango y lo igualamos al Array que hemos creado con los nombres que queremos usar como encabezados, la coma es el separador entre los distintos elementos del array.

Para colorear las letras, usamos la propiedad font.color y usando una constante para darle color rojo.

Para dar formato negrita, pasamos propiedad Bold como true.

Ya se que es un post cortito, pero para los que no conocéis este método, estoy seguro que os seré de utilidad en algún momento.

Descarga el archivo de ejemplo pulsando en: COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

SELECCIONAR DE DOS EN DOS HOJAS Y GUARDARLAS EN UN DIRECTORIO DETERMINADO

Hola a todos:

Cuando creamos procesos o programamos siempre lo hacemos pensando en nuestras necesidades y la mejor adaptación a las mismas.

En el post de hoy voy a plantear la siguiente situación, imaginad que tenéis que pasar una serie de informaciones de manera periódica a un directorio, pero no es un archivo, ni una hoja, sino que cada dos hojas debemos generar un archivo y guardarlo en una carpeta determinada.

Por ejemplo, este sería el archivo, como podéis ver tenemos por cada informe un detalle de info, es decir, debemos guardar 4 archivos de dos pestañas cada uno:

SELECCIONAR DE DOS EN DOS HOJAS Y GUARDARLAS EN UN DIRECTORIO DETERMINADO_1

Esto se puede resolver de distintas formas, hoy os propongo un ejemplo utilizando un array para seleccionar las 2 hojas.

La macro que vamos a usar es la siguiente:

Option Explicit
Sub CADA_N_HOJA()
'Declaramos variables
Dim dir_Archivo As Variant, Directorio As String
Dim Fin As Long, Cnt As Long, i As Long, Hoja As String, Hoja_n As String
'Seleccionamos carpeta
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Obtenemos ruta a la carpeta
Directorio = dir_Archivo.SelectedItems(1)
'Contamos el número de hojas de nuestro archivo
Fin = ThisWorkbook.Sheets.Count
'Creamos un contador
Cnt = 1
'Recorremos las hojas
For i = 1 To Fin Step 2
Cnt = i + 1
'Creamos dos variables para obtener el nombre de cada hoja
Hoja = Worksheets(i).Name
Hoja_n = Worksheets(Cnt).Name
'Pasamos las variables a un array
'Y seleccionamos y pegamos las hojas de 2 en 2
Sheets(Array(Hoja, Hoja_n)).Select
Sheets(Array(Hoja, Hoja_n)).Copy
'Guardamos los archivos creados.
ActiveWorkbook.SaveAs Filename:=Directorio & "\" & Hoja
'Cerramos el archivo después de guardarlo
ActiveWorkbook.Close
Next i
End Sub

Estamos usando un for para asignar a la variable “i” la primera hoja/pestaña a seleccionar y un contador (Cnt) para seleccionar la segunda hoja. Dado que las hojas se pueden nombrar, es importante extraer el nombre de la hoja (con el objeto Name), lo que nos va a permitir especificar en el array el nombre de la hoja que debemos seleccionar.

Una vez que hemos seleccionado las hojas, las copiamos y las guardamos en el directorio/carpeta que hemos indicado al principio de la macro.

El resultado es el siguiente:

Como podéis observar, la macro hace lo esperado, selecciona cada dos hojas y las guarda en la carpeta que hayamos seleccionado.

No he incluido ningún botón para ejecutar la macro, lo podéis hacer directamente desde el editor de VBA.

Y esto es todo, espero que os sea de utilidad!!.

Descarga el archivo de ejemplo pulsando en: SELECCIONAR DE DOS EN DOS HOJAS Y GUARDARLAS EN UN DIRECTORIO DETERMINADO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

REALIZAR VARIAS CONSULTAS SQL CON ADO EN LA MISMA MACRO

Hola a todos!.

¿Qué tal os va?, espero que bien!. Hoy voy tratar el tema de las consultas SQL con ADO, en concreto voy a mostraros un método para poder realizar varias consultas SQL en una única macro.

Voy a partir de un post anterior para realizar el ejercicio: CRUZAR DOS TABLAS EN EXCEL USANDO SQL

En este post, mostraba la forma de realizar un cruce de dos bases de datos mediante consultas SQL usando ADO para obtener, altas, bajas, y movimientos entre los departamentos de unos grandes almacenes.

Si consultais las macros, veréis que hay cuatro en total, una para cada consulta. El motivo de hacerlo de esta forma es para se pueda comprender mejor la forma de usar ADO para quienes lo están empezando a programar y no me gusta complicar en exceso las programaciones dado que muchas veces, lo complicado en lugar de generar curiosidad, genera frustración.

Dicho esto, y una vez publicada la entrada anterior, ya puedo mostrar la forma de hacerlo en una única macro.

El código que vamos a utilizar es similar al ya utilizado, solo que vamos a escribir las cuatro sentencias SQL en el mismo código:

Sub GENERAR_CONSULTA()
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection, fin As Integer, milibro As String, i As Long
Dim alta As String, baja As String, alta_seccion As String, baja_seccion As String
Dim consulta As Variant, titulo As String
fin = Application.CountA(Sheets("MOVIMIENTOS").Range("A:A"))
'Borramos datos de consultas anteriores
Sheets("MOVIMIENTOS").Range("A2:D" & fin + 1).Clear
'indicamos los parámetros de las consultas que necesitamos:
'buscamos empleados nuevos
alta = "SELECT [BBDD_ACTUAL$].[ID], [BBDD_ACTUAL$].[NOMBRE COMPLETO], [BBDD_ACTUAL$].[SECCION], 'NUEVO EMPLEADO' AS ESTADO " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE(([BBDD_ANTERIOR$].[ID]) IS NULL)"
'buscamos empleados que han sido baja
baja = "SELECT [BBDD_ANTERIOR$].[ID], [BBDD_ANTERIOR$].[NOMBRE COMPLETO], [BBDD_ANTERIOR$].[SECCION], 'BAJA' " & _
"FROM [BBDD_ANTERIOR$] LEFT JOIN [BBDD_ACTUAL$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE(([BBDD_ACTUAL$].[ID]) IS NULL)"
'buscamos movimientos de alta en departamento
alta_seccion = "SELECT [BBDD_ACTUAL$].[ID], [BBDD_ACTUAL$].[NOMBRE COMPLETO], [BBDD_ACTUAL$].[SECCION], 'ALTA SECCION' " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE([BBDD_ACTUAL$].[SECCION]) NOT LIKE [BBDD_ANTERIOR$].[SECCION] "
'buscamos movimientos de baja en departamento
baja_seccion = "SELECT [BBDD_ANTERIOR$].[ID], [BBDD_ANTERIOR$].[NOMBRE COMPLETO], [BBDD_ANTERIOR$].[SECCION], 'BAJA SECCION' " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE([BBDD_ANTERIOR$].[SECCION]) NOT LIKE [BBDD_ACTUAL$].[SECCION] "
'iniciamos loop por cada consulta SQL
For Each consulta In Array(alta, baja, alta_seccion, baja_seccion)
fin = Application.CountA(Sheets("MOVIMIENTOS").Range("A:A")) + 1
'Obtenemos el nombre del libro
milibro = ThisWorkbook.Name
'Creamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & milibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
Set Dataread = New ADODB.Recordset
With Dataread
.Source = consulta
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
'pasamos información a la hoja movimientos
With Worksheets("MOVIMIENTOS")
.Cells(fin, 1).CopyFromRecordset Dataread
End With
'ejecutamos la siguiente consulta
Next consulta
Set Dataread = Nothing
Set cnn = Nothing
End Sub

Como podéis observar, reducimos significativamente el tamaño de nuestro código y lo hacemos más eficiente y compacto. La clave está es crear un loop sobre el que iremos pasando cada una de las consultas SQL. Esto se consigue indicando el nombre de cada consulta en un array:

For Each consulta In Array(alta, baja, alta_seccion, baja_seccion)

El objeto “consulta” contendrá la secuencia SQL de cada consulta, lo que nos va a permitir pasar esos parámetros al recordset:

.Source = consulta

De esta forma en cada ciclo del loop tendremos el resultado de cada consulta, luego solo tenemos que pasar la información a la hoja movimientos y utilizar la variable “fin” para indicar el final de los datos de cada consulta y que se pueda mostrar el resultado en conjunto.

Una vez ejecutada la macro, tenemos el siguiente resultado, el mismo que el post del que estamos haciendo referencia.

REALIZAR VARIAS CONSULTAS SQL EN LA MISMA MACRO CON ADO

Y esto es todo, un método muy sencillo (dentro de la complejidad de ADO), que seguro os ayudará a realizar códigos más reducidos y eficientes.

Descarga el archivo de ejemplo pulsando en: REALIZAR VARIAS CONSULTAS SQL EN LA MISMA MACRO CON ADO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

OBTENER DATOS A TRAVÉS DEL OBJETO WScript.Network Y OTRAS INFORMACIONES

Hola a todos!.

Recientemente recibí una consulta en la que un lector me preguntaba si le podía echar una mano  con una macro con la que deseaba extraer información de su equipo, en concreto necesitaba obtener el usuario de un equipo, el nombre del equipo, el nombre del dominio y la fecha y hora de la extracción de los datos.

Para poder conseguir los datos vamos a programar sobre el objeto WScript.Network, dado que sus propiedades (Username, UserDomain, ComputerName) nos van a permitir conocer los tres primeros datos.

De hecho, con esta simple macro obtendríamos la información:

Set sNetwork = CreateObject("WScript.Network")
nEqu = sNetwork.ComputerName
nDom = sNetwork.UserDomain
nUser = sNetwork.UserName

Efectivamente, creamos el objeto WScript.Networky a través de sus propiedades obtenemos la información que guaramos en tres variables.

Para obtener la fecha y la hora, podríamos usar la función Now en VBA, pero dado que estamos trabajando con scripts, lo haremos de la siguiente forma, con un objeto SWbemDateTime:

Set dtTime = CreateObject(“WbemScripting.SWbemDateTime”)
dtTime.SetVarDate (Now)
rDate = dtTime.GetVarDate

Y ya tendríamos los datos que el lector nos ha pedido. : )

El código completo sería así (con algunas cosas más que he añadido)

Sub INFORMACION_USUARIO()
'Declaramos variables
Dim sNetwork As Object, fSistem As Object, tSistem As Object, dir_Archivo As Object
Dim dtTime As Object, rDate As Date, i As Integer, MatrizInfo As Variant
Dim nEqu As String, nDom As String, nUser As String, Directorio As String
'Abrimos cuadro de dialogo para seleccionar carpeta
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Guardamos ruta a esta carpeta
Directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto Network para obtener las propiedades de usuario, equipo y dominio
Set sNetwork = CreateObject("WScript.Network")
nEqu = sNetwork.ComputerName
nDom = sNetwork.UserDomain
nUser = sNetwork.UserName
'obtenemos la fecha y hora del sistema
Set dtTime = CreateObject("WbemScripting.SWbemDateTime")
dtTime.SetVarDate (Now)
rDate = dtTime.GetVarDate
'Creamos objeto filesistem para crear TXT
Set fSistem = CreateObject("Scripting.FileSystemObject")
Set tSistem = fSistem.CreateTextFile(Directorio & "\INFORMACION.txt", True)
'Pasamos los datos al TXT
tSistem.WriteLine "Nombre del equipo:" & nEqu
tSistem.WriteLine "Nombre del dominio:" & nDom
tSistem.WriteLine "Nombre del usuario:" & nUser
tSistem.WriteLine "Fecha y hora:" & rDate
'También pasamos los datos a la hoja
MatrizInfo = Array(nEqu, nDom, nUser, rDate)
For i = LBound(MatrizInfo) To UBound(MatrizInfo)
Sheets(1).Cells(i + 1, 1) = MatrizInfo(i)
Next i
'Vaciamos variable de objeto
Set sNetwork = Nothing
Set fSistem = Nothing
Set tSistem = Nothing
Set dir_Archivo = Nothing
Set dtTime = Nothing
End Sub

Me ha parecido interesante incluir un cuadro de diálogo para seleccionar un directorio en el que vamos a guardar en un TXT los datos extraídos:

El cuadro de diálogo y la extracción del directorio lo hacemos así:

Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Guardamos ruta a esta carpeta
Directorio = dir_Archivo.SelectedItems(1)

y para crear el TXT y pasar los datos, usaremos el objeto FileSystemObject:

'Creamos objeto filesistem para crear TXT
Set fSistem = CreateObject("Scripting.FileSystemObject")
Set tSistem = fSistem.CreateTextFile(Directorio & "\INFORMACION.txt", True)
'Pasamos los datos al TXT
tSistem.WriteLine "Nombre del equipo:" & nEqu
tSistem.WriteLine "Nombre del dominio:" & nDom
tSistem.WriteLine "Nombre del usuario:" & nUser
tSistem.WriteLine "Fecha y hora:" & rDate

Una vez seleccionada la carpeta la macro creará el TXT (INFORMACION) y pasará la info, en mi caso la información es muy repetitiva, dado que siempre es la misma:

OBTENER DATOS A TRAVES DEL OBJETO WScript.Network Y OTRAS INFORMACIONES

Por último, he añadido los resultados en una matriz que luego pasamos a un loop para mostrar la información en la primera hoja de nuestro archivo, en la columna A:

MatrizInfo = Array(nEqu, nDom, nUser, rDate)
For i = LBound(MatrizInfo) To UBound(MatrizInfo)
Sheets(1).Cells(i + 1, 1) = MatrizInfo(i)
Next i

Y se mostraría así:

OBTENER DATOS A TRAVES DEL OBJETO WScript.Network Y OTRAS INFORMACIONES2

Aunque he incluido algunas cosas que el lector no pedía, creo que siempre es bueno incorporar herramientas nuevas o diferentes, de un modo o de otro, siempre nos podrían servir para otros proyectos.

Espero que os haya resultado de interés y os pueda ser de utilidad.

Descarga el archivo de ejemplo pulsando en:  OBTENER DATOS A TRAVES DEL OBJETO WScript.Network Y OTRAS INFORMACIONES

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

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

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

Hola a todos ¿Cómo estáis?.

Llevo unos días preparando nuevo material para actualizar Excel Signum. Desde hace tiempo tengo ganas de abordar el tema de los grandes volúmenes de datos, del famoso “BIG DATA” y las posibilidades que nos puede ofrecer Excel (tanto sus funciones como VBA) para trabajar con estos datos.

Antes de comenzar me gustaría realizar algunas apreciaciones sobre este asunto:

– Existen múltiples herramientas y plataformas especializadas en el BIG DATA. En esta web vamos a ver algunos ejemplos que podemos utilizar para trabajar con Excel llegando a rozar sus limitaciones, pero con resultados efectivos. Es decir, no pretendo indicar con esto que Excel puede cubrir todas nuestras necesidades en lo que a BIG DATA se refiere, dado que contamos con limitaciones importantes que iré comentando a lo largo del POST.

– De la misma forma que Excel tiene sus limitaciones, también podemos contar con algunas funciones, herramientas y código VBA para llegar a resultados muy interesantes y dignos cuando estamos trabajando con grandes volúmenes de información.

– Existen varios complementos en Excel como Power Query y Power Pivot que nos pueden resultar muy interesantes y también facilitar mucho nuestro trabajo. No obstante, de estos recursos hablaré en futuros post.

– Dado que será un tema bastante largo y posiblemente “denso” (habrá mucho código), he decidido realizar el post en tres partes:

* La primera: dedicada a la importación masiva de datos a Excel.
* La segunda: dedicada a la extracción de información.
* La tercera: dedicada al análisis de los datos, con herramientas y funciones estadísticas. Data Mining.

Por lo tanto, vamos a comenzar con la primera parte: La importación masiva de la información.

Cuando hablamos de importación masiva de datos, podemos hacer referencia a muchos tipos de datos, formatos, tipos de archivo, etc. y cada uno con su técnica específica de importación. Para este ejemplo vamos a trabajar con un fichero plano, un TXT de ancho fijo.

Aunque ya he dedicado un post al tema de importar archivos TXT de ancho fijo:  IMPORTAR ARCHIVOS TXT DE ANCHO FIJO, para este ejemplo vamos a utilizar otra técnica que veremos a continuación. Pero antes necesitaré un archivo TXT en el que basar el ejemplo, y que mejor lugar para encontrarlo que el INE!

Buscando entre toda la información y tipos de encuestas, me ha parecido muy interesante esta: Encuesta Europea de Salud en España donde tenemos una gran cantidad de información que nos servirá para realizar todo el ejercicio.

En esta captura de pantalla podéis ver en el lugar en el que debemos descargar el archivo TXT, en la pestaña “Microdatos”  >  Encuesta 2014 > Fichero de Microdatos > Elegir Formato y elegimos Formato TXT en ZIP:

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL

Una vez que lo hemos descargado, debemos descargar otro archivo importante, que se encuentra justo encima “Fichero de registro y valores válidos de las variables”.

Este fichero es imprescindible, dado que nos informará de la longitud de los campos que vamos a importar en el archivo PDF, el ancho fijo y el nombre de cada campo o variable así como su definición valor, es decir las especificaciones.

Por ejemplo, en la pestaña “Diseño de Registro” podemos ver el nombre de la variable, la longitud, la posición de inicio, la posición final y la descripción de la variable:

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL1

En la pestaña: Variables y valores, veremos los valores que pueden tener cada una de las variables:

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL2

Para esta primera parte solo vamos a necesitar de la pestaña “Diseño de Registro”: el nombre de la variable y la longitud. Estos campos los vamos a copiar a nuestro archivo de Excel en la pestaña “ESPECIFICACIONES” y añadiremos una nueva columna que vamos a denominar “TIPO FORMATO”:

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL3

También vamos a renombrar una nueva pestaña como “DATOS”, que es donde mostraremos los datos que importemos.

Ahora os dejo el código que debemos pegar en nuestro editor VBA en un módulo estándar:

Sub IMPORTAR_TXT_ANCHO_FIJO()
'Definimos variables
Dim Ancho As Variant, Tipo As Variant, Titulo As Variant
Dim Archivo As String, nFilas As Integer
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Generamos los array necesarios para determinar
'ancho y tipo de datos a la hora de importar el TXT
With Sheets("ESPECIFICACIONES")
nFilas = Application.CountA(.Range("A:A"))
Titulo = Application.Transpose(.Range("A2:A" & nFilas).Value)
Ancho = Application.Transpose(.Range("B2:B" & nFilas).Value)
Tipo = Application.Transpose(.Range("C2:C" & nFilas).Value)
End With
'Abrimos cuadro de diálogo para seleccionar TXT
Filtro = " TXT(*.TXT),"
Archivo = Application.GetOpenFilename(Filtro)
'Si no seleccionamos nada, salimos del proceso
If Archivo = "Falso" Or Archivo = Empty Then
Exit Sub
End If
'Eliminamos los datos de la hoja "DATOS"
Call ELIMINA_DATOS
'Iniciamos el proceso
Sheets("DATOS").Select
With Sheets("DATOS")
'Indicamos encabezado de columnas
'que se encuenta en las especificaciones
.Range("A1:PL1").Value = Titulo
'Iniciamos Query y nos traemos la información del TXT
With .QueryTables.Add(Connection:= _
"TEXT;" & Archivo, Destination:=Range( _
"$A$2"))
.Name = "CONSULTA_1"
.AdjustColumnWidth = False
.TextFileParseType = xlFixedWidth
'Hacemos referencia al tipo de datos que queremos importar
'en este caso, número (1)
.TextFileColumnDataTypes = Array(Tipo)
'Indicamos el ancho de cada columna
'que se encuentra también en las especificaciones y que hemos
'convertido en un array, al igual que el tipo y el título
.TextFileFixedColumnWidths = Array(Ancho)
.TextFileTrailingMinusNumbers = True
'On Error Resume Next
.Refresh BackgroundQuery:=False
'On Error GoTo 0
End With
End With
Application.ScreenUpdating = True
End Sub

Para que la macro funcione correctamente, es necesario pegar esta otra a continuación:

Sub ELIMINA_DATOS()
'Definimos variables
Dim cnn As Object, table As Object
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Seleccionamos la hoja Datos
Sheets("DATOS").Select
With Sheets("DATOS")
'Borramos TODAS las conexiones que tenga el libro
For Each cnn In ThisWorkbook.Connections
cnn.Delete
Next cnn
'Borramos todas las tablas de la hoja activa
For Each table In .QueryTables
table.Delete
Next table
'Borramos todos los contenidos de la hoja activa
.Range(.Cells(1, 1), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Delete Shift:=xlToLeft
.Range("A1").Select
End With
Application.ScreenUpdating = True
End Sub

Y ahora vamos a comentar algunas partes del código que me parece interesante. En primer lugar, para que podamos capturar el archivo TXT he incluido un cuadro de diálogo para seleccionarlo más cómodamente.

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL5

Dado estamos utilizando el método “QueryTables.Add“, es necesario que automaticemos las matrices que dan valor al ancho fijo y al tipo de formato de los datos que vamos a importar con la consulta.

Para eso, obtendremos las matrices de cada campo con los datos que hemos pegado anteriormente en la hoja ESPECIFICACIONES. Estos son los tres campos que necesitamos:

Titulo = Application.Transpose(.Range("A2:A" & nFilas).Value)
Ancho = Application.Transpose(.Range("B2:B" & nFilas).Value)
Tipo = Application.Transpose(.Range("C2:C" & nFilas).Value)

Y los vamos a utilizar en las siguientes líneas de código.

.TextFileFixedColumnWidths = Array(Ancho)
.TextFileColumnDataTypes = Array(Tipo)

Para el tipo de formato, indicar que estoy utilizando el 1, que se refiere a número. Si quisiéramos importar con formato texto sería el 2, (es importante decidir el formato que nos interesa, dado que posteriormente puede ser relevante para los cálculos).

Como también tenemos el nombre de todos los campos y los hemos pasado a una matriz, podemos pasar el rango a la primera fila de la hoja datos, indicando la última fila, es decir la columna 428 o PL, esto lo podemos automatizar, pero he preferido dejarlo así para mayor claridad.

.Range("A1:PL1").Value = Titulo

Por último, la macro ELIMINA_DATOS(), elimina la tabla que hemos importado anteriormente por si es necesario repetirla varias veces.

Es importante comentar que con esta macro, a diferencia de la que escribí en el post anterior, nos ahorramos 10 minutos en la importación. Tanto los métodos utilizados como la posibilidad de automatizar la carga de las matrices, son la forma más eficiente de trabajar con esta información en Excel.

No vamos a poder trabajar directamente con ADO, dado que tiene la limitación de los 255 campos y hacerlo mediante procesos for ralentizaría demasiado la tarea.

Una vez que ejecutamos la macro, esta es la información que obtenemos:

TRABAJAR CON GRANDES BASES DE DATOS EN EXCEL4

En total, tenemos 428 columnas y 22.843 filas, una cantidad bastante importantes de datos con la que podemos empezar a extraer información (aunque esto lo haremos en el siguiente post) 😉

Esta macro está pensada y diseñada para trabajar con versiones de Excel 2010 en adelante. No lo he probado en Excel 2007, pero debería funcionar correctamente. La extensión del archivo siempre ha de ser xlsm, dada la extensión de las columnas (superan las 255). De hecho, si estuviésemos trabajando en Access tendríamos la limitación de los 255 campos (incluso en Access 2016), sin embargo en Excel no tenemos ese problema.

Con los ajustes adecuados podremos realizar importaciones hasta los límites que nos asigne EXCEL, tanto en filas como en columnas, e incluso podríamos pensar en utilizar varias hojas para guardarnos tablas mucho más grandes.

Y este ha sido el primero de los tres post sobre trabajar con grandes bases de datos. Os dejo la información en Google Drive, dado que en WordPress no se permiten archivos TXT ni XLSM.

En el próximo post trataré el cómo vamos a extraer la información que nos interesa, y no voy a utilizar bucles, sino otra herramienta que nos va a venir muy bien y que estamos acostumbrados a usar de otra forma.

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