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
Do Until Dataread.EOF
Dataread.MoveFirst
With Worksheets("MOVIMIENTOS")
.Cells(fin, 1).CopyFromRecordset Dataread
'Indicamos encabezados
For i = 0 To Dataread.Fields.Count - 1
titulo = Dataread.Fields(i).Name
.Cells(1, i + 1) = titulo
Next
.Cells(1, Dataread.Fields.Count) = "ESTADO"
End With
Loop
'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 CON ADO EN LA MISMA MACRO

¿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

Anuncios

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

 

PASAR INFORMACIÓN DE UN RANGO A UNA CELDA

Hola a todos 🙂

Hace unos días me enviaron una consulta sobre la necesidad de pasar la información contenida en un rango de celdas a una única celda.

Hola Segu:
Tengo varias columnas con datos y quiero pasarlos a una celda. No es transponer esos datos, es introducir todo el rango en esa celda y separarlos con una coma ¿Cómo podría hacerlo?.
Muchas gracias.

Aunque la pregunta resulta extraña, este tipo de formato resulta útil para cuando tenemos que trabajar con matrices en VBA (Array). Pero vayamos a la consulta, in situ:

Voy a aprovechar la información de otro post para realizar el ejemplo. Imaginad que tenemos los datos de facturación de los comerciales de una empresa distribuidos por meses.

PASAR INFORMACION DE UN RANGO A UNA CELDA

Y queremos pasar los importes de cada mes (el rango) a una ÚNICA celda. En este ejemplo pasaremos los datos a la hoja “RESULTADO”.

Para realizar este ejercicio, utilizaremos la siguiente macro:

Sub RANGO_A_CELDA()
'Declaramos las variables
Dim i As Integer, j As Integer
Dim ncolumna As Integer, nfila As Integer
Dim sCadena As String
'Eliminamos cualquier información en la hoja RESULTADO
Sheets("RESULTADO").Select
With Sheets("RESULTADO")
.Range(.Cells(1, 1), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
.Range("A1").Select
End With
'Iniciamos bucle por columna
With Sheets("DATOS")
ncolumna = Application.CountA(.Range("1:1"))
For i = 1 To ncolumna
'Iniciamos bucle por cada fila de datos
nfila = Application.CountA(.Columns(i))
'En cada Rango debemos vaciar los datos de sCadena
sCadena = vbNullString
'Podemos elegir el separador entre los datos,
'en este caso una coma ","
For j = 2 To nfila
sCadena = sCadena & .Cells(j, i) & ","
Next j
'Llevamos los datos a la hoja RESULTADO
'y formateamos a texto cada celda
With Sheets("RESULTADO")
.Range("A1") = "RESULTADO"
.Range("A" & i + 1).NumberFormat = "@"
.Range("A" & i + 1) = Trim(Mid(sCadena, 1, Len(sCadena) - 1))
End With
Next i
End With
End Sub

Una vez que ejecutamos el código, obtenemos esta información:

PASAR INFORMACION DE UN RANGO A UNA CELDA1

Y como podéis observar, hemos codificado en cada celda toda la información del rango. En total son doce celdas (una por cada mes).

Sobre esta línea del código:

.Range("A" & i + 1) = Trim(Mid(sCadena, 1, Len(sCadena) - 1))

La he utilizado para eliminar el último carácter, que en este caso es una coma. De otra forma, la cadena de datos finalizaría de forma errónea (bajo mi punto de vista).

Como ya dije, estoy utilizando una coma como separador de la información, pero se podía utilizar cualquier otro carácter (o un espacio).

Y eso es todo, si en algún momento tenéis que pasar los datos de una columna a una celda, ahora lo tendréis más fácil.

Descarga el archivo pulsando en: PASAR INFORMACIÓN DE UN RANGO A UNA CELDA

 

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