PASAR UNA CADENA DE TEXTO A UNA MATRIZ Y UTILIZARLO EN UN BUCLE

Hola a todos!

Hoy voy a tratar un tema concreto a nivel programación, un pequeño “tip” de una forma o método para realizar la siguiente tarea: pasar una cadena de texto a un array o matriz y a su vez, poder utilizarla en un bucle (en este caso usaré “for each”).

Voy a realizar un ejemplo sencillo con el que podréis entenderlo perfectamente. Este trabajo también se podría realizar con otras técnicas, pero hoy quiero centrarme en esta.

Veamos, imaginad que tenemos en una columna una serie de números:

PASAR UNA CADENA DE TEXTO A UN ARRAY Y UTILIZARLO EN UN BUCLE

Para poder pasar esta serie de números a una cadena de texto, tenemos que componerla y lo podemos hacer con un ciclo for – next:

Así:

With Sheets("Hoja1")
Fin = Application.CountA(.Range("A:A"))
For i = 2 To Fin
mStr = mStr & "|" & .Cells(i, 1)
Next i
End with
End sub

Utilizaremos la barra “|” como separador en nuestra cadena.

El resultado es el siguiente:

|371|282|404|881|804|812|742|833|242|294|931|725|942|909|103|519|380|190|42|892|764|333|352|18|887|889|319

Y como podéis observar, nos ha quedado una barra al inicio de la cadena que es necesario eliminar, para ellos debemos hacerlo con las siguientes funciones:

mStr = Mid(mStr, 2, Len(mStr))

Una vez que tenemos nuestra string o cadena de texto depurada, ya podemos dar el siguiente paso, crear una matriz con cada una de sus subcadenas. Utilizaremos la función “Split”:

mtrz = Split(mStr, "|")

Y ahora que tenemos toda la información, ya podemos utilizar la matriz en nuestro loop o bucle:

For Each numero In mtrz
.Cells(2, 3) = "RESULTADO: " & numero & "*2= " & numero * 2º1
Application.Wait (Now + TimeValue("00:00:01"))
Next numero

Donde “numero” se corresponde con cada subcadena de nuestra matriz, que en este caso es un número.

En el loop simplemente multiplico por 2 cada número y lo muestro en la hoja1 con un “retardo en la ejecución de cada multiplicación de 1 segundo”.

Y resulta esto:

PASAR UNA CADENA DE TEXTO A UN ARRAY Y UTILIZARLO EN UN BUCLE1

Sin embargo, el motivo de este post es mostrar una forma o método para crear una matriz a partir de un string y poder utilizarlo en un bucle.

Aunque este ejemplo es muy sencillo y se podría realizar lo mismo con un simple bucle for next, no os quedéis con esa idea, sino con que este  método os puede resultar muy útil para otros procedimientos más complejos.

Descarga el archivo de ejemplo pulsando en: PASAR UNA CADENA DE TEXTO A UNA MATRIZ Y UTILIZARLO EN UN BUCLE

¿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

REALIZAR CONSULTAS SQL DE UNIÓN EN EXCEL CON ADO

Hola a todos!:

Hacía tiempo que no subía un post nuevo, pero últimamente estoy bastante escaso de tiempo y esta semana me han enviado algunas consultas de gran complejidad, lo que me ha dejado poco margen para publicar. Pero hoy sí puedo : )

Para este post escribiré acerca de las ventajas de las consultas de unión a la hora de realizar nuestros trabajos y programaciones.

Básicamente una consulta de unión se especifica en SQL con las instrucciones UNION y UNION ALL, ambas realizan el trabajo de unir dos o más consultas SQL, solo que cuando es UNION el resultado de la consulta solo devuelve los valores distintos (sin duplicados) y cuando es UNION ALL devuelve todos los valores (pueden incluir duplicados).

Para el ejemplo de hoy se podrían utilizar ambas, dado que los elementos son distintos en las dos bases de datos.

Imaginad que tenemos dos tablas (que pueden ser archivos independientes, pero para este ejemplo lo hago todo dentro del mismo archivo). Una se corresponde con un grupo de trabajadores de unos grandes almacenes y la otra con otro grupo, las llamaré GRUPO1 y GRUPO2 respectivamente:

REALIZAR CONSULTAS SQL DE UNION EN EXCEL

Pues bien, deseamos obtener un único archivo con lo siguiente:

Del GRUPO1 personas con sexo = “MUJER” y estudios = “DIPLOMADOS” y que los nombres no sean nulos (dado que hemos detectado que en algunas ocasiones el campo “NOMBRE COMPLETO” tiene celdas vacías. La sentencia SQL sería esta:

"SELECT [GRUPO1$].[NOMBRE COMPLETO],[GRUPO1$].[EDAD], [GRUPO1$].[SEXO], [GRUPO1$].[ESTUDIOS], 'GRUPO1' AS GRUPO FROM [GRUPO1$] WHERE NOT [GRUPO1$].[NOMBRE COMPLETO] IS NULL AND [GRUPO1$].[SEXO]='MUJER' AND [GRUPO1$].[ESTUDIOS]='DIPLOMADOS' "

Del GRUPO2 personas con sexo = “HOMBRE” y estudios = “DIPLOMADOS” y que los nombres no sean nulos (dado que hemos detectado que en algunas ocasiones el campo “NOMBRE COMPLETO” tiene celdas vacías. La sentencia SQL sería esta:

SELECT [GRUPO2$].[NOMBRE COMPLETO],[GRUPO2$].[EDAD], [GRUPO2$].[SEXO], [GRUPO2$].[ESTUDIOS], 'GRUPO2' AS GRUPO FROM [GRUPO2$] WHERE NOT [GRUPO2$].[NOMBRE COMPLETO] IS NULL AND [GRUPO2$].[SEXO]='HOMBRE' AND [GRUPO2$].[ESTUDIOS]='DIPLOMADOS' "

Una vez definidas las consultas, introducimos la instrucción UNION ALL y componemos nuestro string para pasar la consulta en nuestro código, así sería completo:

obSQL = "SELECT [GRUPO1$].[NOMBRE COMPLETO],[GRUPO1$].[EDAD], [GRUPO1$].[SEXO], [GRUPO1$].[ESTUDIOS], 'GRUPO1' AS GRUPO FROM [GRUPO1$] WHERE NOT [GRUPO1$].[NOMBRE COMPLETO] IS NULL AND [GRUPO1$].[SEXO]='MUJER' AND [GRUPO1$].[ESTUDIOS]='DIPLOMADOS' UNION ALL " & _
"SELECT [GRUPO2$].[NOMBRE COMPLETO],[GRUPO2$].[EDAD], [GRUPO2$].[SEXO], [GRUPO2$].[ESTUDIOS], 'GRUPO2' AS GRUPO FROM [GRUPO2$] WHERE NOT [GRUPO2$].[NOMBRE COMPLETO] IS NULL AND [GRUPO2$].[SEXO]='HOMBRE' AND [GRUPO2$].[ESTUDIOS]='DIPLOMADOS' "

El resultado de ejecutar la consulta sería el siguiente:

REALIZAR CONSULTAS SQL DE UNION EN EXCEL1

Efectivamente, nuestras dos consultas se han unido en una única consulta. Mostrando un total de 3 mujeres en el GRUPO1 y 1 hombre en el GRUPO2. Indicar que tal y como queríamos hemos obviado las celdas en blanco del campo NOMBRE COMPLETO.

Ahora os dejo la macro completa:

Option Explicit
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 titulo As String
fin = Application.CountA(Sheets("UNION").Range("A:A"))
'Borramos datos de consultas anteriores
Sheets("UNION").Range("A2:E" & fin + 1).Clear
'construimos nuestras dos consultas y las unimos
obSQL = "SELECT [GRUPO1$].[NOMBRE COMPLETO],[GRUPO1$].[EDAD], [GRUPO1$].[SEXO], [GRUPO1$].[ESTUDIOS], 'GRUPO1' AS GRUPO FROM [GRUPO1$] WHERE NOT [GRUPO1$].[NOMBRE COMPLETO] IS NULL AND [GRUPO1$].[SEXO]='MUJER' AND [GRUPO1$].[ESTUDIOS]='DIPLOMADOS' UNION ALL " & _
"SELECT [GRUPO2$].[NOMBRE COMPLETO],[GRUPO2$].[EDAD], [GRUPO2$].[SEXO], [GRUPO2$].[ESTUDIOS], 'GRUPO2' AS GRUPO FROM [GRUPO2$] WHERE NOT [GRUPO2$].[NOMBRE COMPLETO] IS NULL AND [GRUPO2$].[SEXO]='HOMBRE' AND [GRUPO2$].[ESTUDIOS]='DIPLOMADOS' "
'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 = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
'pasamos información a la hoja UNION
Do Until Dataread.EOF
Dataread.MoveFirst
With Worksheets("UNION")
.Cells(2, 1).CopyFromRecordset Dataread
'Indicamos encabezados
For i = 0 To Dataread.Fields.Count - 1
titulo = Dataread.Fields(i).Name
.Cells(1, i + 1) = titulo
Next
End With
Loop
'ejecutamos el resto de consultas
Set Dataread = Nothing
Set cnn = Nothing
End Sub

Como podéis observar, la estructura del código es la misma que suelo publicar en los post en los que trabajo con ADO y SQL en Excel.

Y eso es todo. Es una forma útil cuando necesitamos consolidar información de varios archivos pero especificando criterios distintos en cada base de datos.

Descarga el archivo de ejemplo pulsando en: REALIZAR CONSULTAS SQL DE UNIÓN EN EXCEL 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

EXTRAER TODAS LAS FORMAS O SHAPES INCLUIDAS EN VARIOS ARCHIVOS EXCEL

Hola a todos!

Qué tal estás?, espero que muy bien : )

El viernes recibí una consulta de un lector que tenía el siguiente problema: de un conjunto de archivos Excel necesitaba extraer todas las imágenes que se habían incluido en varias hojas y pasarlas a una única hoja (todas juntas).

Bien, para poder realizar esta tarea con VBA tendremos que crear un código que sea capaz de seleccionar una carpeta específica (donde están los archivos), que solo reconozca los archivos Excel y pueda que recorra todos los libros y hojas para seleccionar solo un tipo de forma (picture).

Un trabajo interesante y del que ya existen en esta web varias macros con contenidos parciales pero que se pueden utilizar y modificar para obtener lo que necesitamos.

Imaginad que tenemos las siguiente imágenes en esta hoja:

EXTRAER TODAS LAS FORMAS O SHAPES INCLUIDAS EN VARIOS ARCHIVOS EXCEL

Este tipo de shapes se corresponden con el tipo “Picture” y en código, el 13. Aquí os dejo una tabla con un resumen de tipos de shapes y códigos:

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba1

Y ahora tenemos que utilizar una macro que nos permita capturar esta información, la macro será la siguiente, está compuesta por una macro y por una función, cuando activamos la macro la función se ejecutará:

Sub EXTRAER_IMAGENES()
'Declaramos variables
Dim sFSO As Object, Directorio As String
Dim dir_Archivo As Variant
'Abrimos ventana de diálogo 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
'Capturamos el directorio del archivo seleccionado
Directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto y ejecutamos función Carpeta
Set sFSO = CreateObject("Scripting.FileSystemObject")
CARPETA sFSO.GetFolder(Directorio)
End Sub

Una vez que ejecutamos la macro, se ejecutará la función CARPETA que va recorrer los archivos detectando los que sean Excel (cualquier versión) y extrayendo todas las imágenes.

Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim j As Long, Subcarpeta As Object
Dim MiExt As String, iLibro As Object
Dim nHoja As Long, shapes As Object
Dim i As Long, file As Object
Application.ScreenUpdating = False
'Con la hoja activa
With ActiveSheet
'Iniciamos dos loop, uno que recorre las carpetas
For Each Subcarpeta In nCarpeta.SubFolders
CARPETA Subcarpeta
Next
'y otro que recorre los archivos y los indexa solo .xls
For Each file In nCarpeta.Files
MiExt = Right(file.Path, Len(file.Path) - InStrRev(file.Path, "."))
If MiExt Like "*xls*" Then
'Abrimos cada libro que se encuentra en la carpeta seleccionada
Set iLibro = Workbooks.Open(Filename:=file.Path)
'contamos las hojas de cada libro
nHoja = ActiveWorkbook.Worksheets.Count
'Iniciamos bucle.
For i = 1 To nHoja
'En cada hoja vamos seleccionando cada shape
'las copiamos y las pegamos en nuestro archivo
For Each shapes In Sheets(i).shapes
With shapes
If .Type = 13 Then
.Select
.Copy
ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.ActiveSheet.Cells(j + 1, 1)
j = j + 10
End If
End With
Next shapes
Next i
'cerramos cada libro que hemos abierto
iLibro.Close
End If
Next
End With
End Function

El resultado es que en nuestro archivo recuperamos las imágenes contenidas en el archivo anterior.

EXTRAER TODAS LAS FORMAS O SHAPES INCLUIDAS EN VARIOS ARCHIVOS EXCEL_1

Es importante que en la carpeta que contiene los archivos con las imágenes no incluyáis el archivo de la macro con el que vamos a extraer la información, la razón es que se generará un error dado que el archivo ya lo tenemos abierto.

El seleccionador de la macro selecciona carpetas (no archivos), por ello debéis seleccionar la carpeta o directorio con los archivos a tratar.

Descarga el archivo de ejemplo pulsando en: EXTRAER TODAS LAS FORMAS O SHAPES INCLUIDAS EN VARIOS ARCHIVOS EXCEL

¿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

EXTRAER DATOS DE UNA SELECCIÓN SEGÚN UN CRITERIO

Hola a todos!.

Hoy voy a escribir un post como respuesta a una consulta que me enviaron hace unos días. Aunque utilizando los diferentes post de esta web se podría confeccionar el código, el lector me comentaba que se veía incapaz de realizar esta tarea, de modo que le comenté que escribiría un post explicando cómo hacer su petición.

La consulta planteada trata sobre la posibilidad de una vez seleccionada un área o rango de celdas, poder extraer esta información según un criterio determinado y pasar dichos datos a una columna determinada. En su ejemplo, me pedía que trabajase con números y un criterio numérico.

Vamos con un ejemplo. Imaginad que tenemos dos columnas con números, y queremos pasar a la tercera columna todos aquellos que sean inferiores a 30:

EXTRAER DATOS DE UNA SELECCION SEGUN UN CRITERIO

Pues bien, para poder realizar esta tarea, nos bastará con pegar este código en un módulo estándar de nuestros editor de VBA:

Sub EXTRAER_DATOS()
'Declaramos variables
Dim celda As Object
Dim j As Long, nCol As Long, n as Long
Dim miCelda As String, matriz As Variant
'Recorremos celdas y seleccionamos dato segun condicion
For Each celda In Selection
If celda < 30 Then miCelda = miCelda & " " & celda
Next celda
'Pasamos los datos a un matriz
matriz = Split(miCelda, " ")
'Contamos elementos
n = UBound(matriz) + 1
'Si no hay datos, mostramos mensajes y salimos del proceso
If n = 0 Then
MsgBox ("NO EXISTEN DATOS SEGÚN LOS CRITERIOS QUE HAS SELECCIONADO")
Exit Sub
End If
'Pasamos los datos a la columna 3
matriz = Split(miCelda, " ")
For j = 0 To UBound(matriz)
ActiveSheet.Cells(j + 1, 3) = matriz(j)
Next j
End Sub

Como podéis ver en el código, simplemente utilizando un loop for-each capturamos los datos seleccionados, luego solo tenemos que indicar aquellos que nos interesan (menor de 30) y pasarlos a un string para finalmente colocarlos en la columna 3.

Este es el resultado:

EXTRAER DATOS DE UNA SELECCION SEGUN UN CRITERIO_1

Y el resultado es el esperado. En la tercera columna tenemos la información que habíamos indicado en la macro.

Y con esto doy la pregunta por contestada : )

Descarga el archivo de ejemplo pulsando en: EXTRAER DATOS DE UNA SELECCIÓN SEGÚN UN CRITERIO

¿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

RECOPILAR INFORMACIÓN DE VARIAS CELDAS DE DISTINTOS ARCHIVOS EN UNA HOJA

Hola a todos!.

Espero que las vacaciones hayan ido muy bien. Yo acabo de finalizarlas y ahora toca comenzar de nuevo con las tareas habituales.

El tema de hoy se basa en una consulta remitida por un lector, que solicita una macro que agrupe o recopile la información contenida en una celda específica en distintos archivos y hojas.

Este es un tema recurrente que ya he tratado en varias ocasiones y para distintos escenarios, sin embargo hoy nos centraremos en extraer la información haciendo referencia solo a celdas y no a rangos de información.

La macro que vamos a utilizar es la siguiente:

Sub RECOPILAR_ARCHIVOS()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer
Dim elimina As Long, FilaInicio As Integer, fin As Long
Dim iArchivo As String, nArchivo As String, MiLibro As String
Dim dir_Archivo As Variant
Dim Hoja_Destino As Worksheet, iLibro As Workbook
'Creamos ventana de diálogo para seleccionar los archivos que queremos agrupar
On Error Resume Next
dir_Archivo = Application.GetOpenFilename(Title:="SELECCIONA ARCHIVOS PARA CONSOLIDAR", MultiSelect:=True, filefilter:="Excel files (*.xls*), *.xls*")
On Error GoTo 0
'Si no seleccionamos archivos, salimos del proceso
If Not IsArray(dir_Archivo) Then
Exit Sub
End If
'Si existen datos en la hoja AGRUPADO, los eliminamos
With ThisWorkbook.Sheets("AGRUPADO")
elimina = Application.CountA(.Range("A:A"))
If elimina > 0 Then .Range("A1:A" & elimina).EntireRow.Delete
End With
'Iniciamos un for con para identificar los archivos seleccionados
If IsArray(dir_Archivo) Then
For j = LBound(dir_Archivo) To UBound(dir_Archivo)
nArchivo = dir_Archivo(j)
'Determinamos a partir de que fila vamos a consolidar los datos
FilaInicio = 1
'Desactivamos actualización de pantalla y eventos
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Identificamos el nombre de nuestro libro
MiLibro = ThisWorkbook.Name
'Indicamos la hoja de destino de los datos que queremos consolidar
Set Hoja_Destino = ThisWorkbook.Sheets("AGRUPADO")
'Listamos los archivos Excel a consolidar
iArchivo = nArchivo
'Si la longitud del archivo es cero, salimos del proceso (no existe archivo para consolidar)
If Len(iArchivo) = 0 Then Exit Sub
'Si el nombre del archivo no es igual a nuestro libro seguimos el proceso
If Not iArchivo = MiLibro Then
'Capturamos ruta al iarchivo
Set iLibro = Workbooks.Open(Filename:=nArchivo)
'Contamos las hojas que tiene
fin = iLibro.Sheets.Count
'Iniciamos un bucle por cada hoja, extraemos los datos que nos interesan
'de cada hoja de cada archivo
For i = 1 To fin
n = Application.CountA(Hoja_Destino.Range("A:A")) + 1
'Traemos datos de la celda B5 de cada hoja
Hoja_Destino.Cells(n, 1) = iLibro.Sheets(i).Range("B5")
'Traemos datos de la celda B6 en cada hoja
Hoja_Destino.Cells(n, 2) = iLibro.Sheets(i).Range("B6")
n = n + 1
iLibro.Close False
Next i
End If
Next j
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Una vez finalizado, lanzamos mensaje de finalización.
MsgBox ("EL PROCESO HA FINALIZADO CORRECTAMENTE"), vbInformation, "PROCESO DE CONSOLIDACIÓN"
End Sub

Tan solo tenemos que pulsar el botón “AGRUPAR” y tendremos la información que hemos indicado agrupada en la hoja “AGRUPADO”, es decir las celdas B5 y B6 de cada hoja y de cada archivo seleccionado:

RECOPILAR INFORMACION DE VARIAS CELDAS DE DISTINTOS ARCHIVOS EN UNA HOJA

Est tipo de macros resultan útiles cuando necesitamos agrupar datos con informaciones dispersas en la hoja, por ejemplo facturas, recibos, etc (siempre que tengan todas la misma estructura).

Y eso es todo, espero que os resulte de interés.

Descarga el archivo de ejemplo pulsando en: RECOPILAR INFORMACIÓN DE VARIAS CELDAS DE DISTINTOS ARCHIVOS EN UNA HOJA

 

¿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
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

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX

Hola a todos!.

Qué tal estáis? espero que bien! y supongo que muchos de vosotros ya estáis disfrutando de las vacaciones o esperando a que lleguen.

Hoy voy a comentar una solución que le ofrecí a un lector que me consultaba cómo podría introducir en un inputbox dos o más datos. Normalmente esta tarea se realiza con un formulario o userform, habilitando tantos cuadros de texto como sean necesarios.

Pero en el caso del inputbox solo tenemos un cuadro de texto, sin posibilidad de poder crear más cuadros de texto. Lo que nos obligaría a crear tantos inputbox como datos necesitemos introducir.

Pero existe una solución para poder introducir valores múltiples en un inputbox. Veamos un ejemplo, imaginad que queréis pasar dos fechas (Inicio y Fin) a través del mismo inputbox y mostrar los datos en las siguientes celdas:

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX

Para poder hacerlo, vamos a utilizar el siguiente código que he programado:

Sub INPUT_VARIOS()
'Declaramos las variables
Dim formulario, miarray
'Invocamos inputbox e indicamos las fechas separadas por una coma
formulario = InputBox("INDICA FECHA INICIO Y FECHA FIN SEPARADO POR UNA COMA:" & Chr(13) & Chr(13) & "EJEM: 01/01/2018,01/03/2018", "FECHAS")
'Si no ponemos nada, salimos del proceso
If formulario = Empty Then Exit Sub
'verificamos que los datos introducidos son correctos, si hay errores, los detectamos al final
On Error GoTo etiqueta
'Pasamos las dos fechas a una matriz utilizando la función split
miarray = Split(formulario, ",")
'Pasamos los datos a cada celda igualando los array
With Sheets("Hoja1")
.Cells(2, 1) = CDate(miarray(0))
.Cells(2, 2) = CDate(miarray(1))
End With
Exit Sub
etiqueta:
MsgBox ("Verifica los datos que has introducido e inténtalo de nuevo"), vbExclamation
End Sub

Al ejecutarlo veremos el siguiente inputbox en nuestra hoja:

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX_1

Como podéis observar en la macro, estamos utilizando la función split para pasar la información que hemos indicado en cuadro de texto del inputbox a una matriz. Como necesitamos indicar un elemento o carácter que separe las dos fechas (o cualquier otro dato), he decido utilizar la coma “,”aunque podríamos usar el punto y coma, “;” una arroba “@” etc, sustituyéndolo en la macro:

miarray = Split(formulario, ",")

Una vez que tenemos ambos datos, tan solo tendremos que pasar la información a las celdas de la hoja que necesitamos rellenar y lo hacemos pulsando en el botón aceptar de nuestro inputbox. Como cortesía hacia el lector, he programados varias líneas de código para controlar los datos erróneos o que surjan errores a la hora de ejecutar la macro.

El resultado es que tenemos en las celdas la información indicada en el cuadro de texto:

INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX_2

Y eso es todo, como podéis observar sí es posible introducir valores múltiples en un inputbox.

Descarga el archivo de ejemplo pulsando en: INTRODUCIR MÚLTIPLES VALORES EN UN INPUTBOX

¿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