Como Buscar un Rango de Números con SQL Cambiando el Orden de las Columnas Extraidas





Consulta un suscriptor del canal, si es posible que al importar los datos se cambie el orden de las columnas al momento de mostrar los datos en la hoja de Excel, la respuesta es SI, esta macro precisamente muestra como buscar por un rango de números cambiando el orden de las columnas al mostrar los datos usando SQL.

Descarguen el ejemplo en forma gratuita sin ninguna restricción desde el final del post, el código se puede adaptar a cada necesidad, Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.








 


Para el ejemplo nos apoyaremos en un libro que contiene la base de datos ya que para la importación de datos se conecta a otro Libro de Excel, descargado el archivo comprimido se deben guardar los dos archivos juntos no importando el directorio, basta con que estén juntos para que la macro lo pueda encontrar.

La conexión se logran con el siguiente código, recuerden que se usa Excel 2016 / 365

mybook = ThisWorkbook.Path & "\414 Conectar Excel con Excel Consulta SQL Base Datos.xlsx"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & mybook & ";Extended Properties=""Excel 12.0;HDR=Yes;"""

Par realizar la consulta se crea el string de consulta o SQL siendo la siguiente:

sql = "SELECT ID,Marca,Pv,Importe,Descripcion,Fecha,Cantidad FROM [" & "Hoja1$" & "] WHERE ID >= " & a.Range("I1") & " AND ID <= " & a.Range("K1") & " ORDER BY ID ASC"

Se debe destacar que para alterar el orden en que se mostrarán las columnas, solo basta con cambiar o alterar el orden en que se ponen las columnas en la SQL es decir en este caso se ponen en el orden que se desea que aparezcan las columnas, no coincidiendo con el orden de las columnas en el Libro de Base de Datos.

Entre la sentencia SELECT y FROM se deben colocar el nombre de las cabeceras de las columnas en el orden que se requieran que se muestren los datos.

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como insertar foto o imagen centrando automáticamente


Como hacer un bucle for next con letras del abecedario

Como crear una factura o sale invoice guardar e imprimir

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Para ejecutar la SQL se usa:

Set rs = cn.Execute(sql)

Para copiar los datos, cuyas columnas se ordenarán de acuerdo a lo ingresado en la SQL se usa el siguiente código

b.Cells(2, 1).CopyFromRecordset Data:=rs

Para copiar las cabeceras de las columnas en la fila 1 de la tabla se usa el siguiente código:

For ii = 1 To 7
b.Cells(1, ii) = rs.Fields(ii - 1).Name
Next ii

Posterior a ello se da ancho automático a las columnas y formato de fecha a la columna F con los siguientes códigos:



b.Range("A:G").EntireColumn.AutoFit
b.Range("F:F").NumberFormat = "dd/mm/yyyy"

Deben recordar de liberar las variables y cerrar la conexión al Libro de la siguiente manera:

Set rs = Nothing
cn.Close
Set cn = Nothing

El código completo del ejemplo llamado Como Buscar un Rango de Números con SQL Cambiando el Orden en que se Muestran Los datos Filtrados, se encuentra a continuación y posteriormente está el link para la descarga del archivo de ejemplo.


Código que se inserta en un módulo

Sub ConsutaSQLExcel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ctl As Object
Dim cn As ADODB.Connection, rs As ADODB.Recordset, sql As String
On Error Resume Next
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set a = Sheets("Hoja1")
Set b = Sheets("Hoja2")

mybook = ThisWorkbook.Path & "\414 Conectar Excel con Excel Consulta SQL Base Datos.xlsx"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & mybook & ";Extended Properties=""Excel 12.0;HDR=Yes;"""
'sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE ID >= " & a.Range("I1") & " AND ID <= " & a.Range("K1") & " ORDER BY ID ASC"

sql = "SELECT ID,Marca,Pv,Importe,Descripcion,Fecha,Cantidad FROM [" & "Hoja1$" & "] WHERE ID >= " & a.Range("I1") & " AND ID <= " & a.Range("K1") & " ORDER BY ID ASC"


b.Cells.Clear
'a.Range("A1:G1").Copy Destination:=b.Range("A1")
Set rs = cn.Execute(sql)
b.Cells(2, 1).CopyFromRecordset Data:=rs

'Carga los datos de la cabecera en listbox
For ii = 1 To 7
b.Cells(1, ii) = rs.Fields(ii - 1).Name
Next ii

b.Range("A:G").EntireColumn.AutoFit

b.Range("F:F").NumberFormat = "dd/mm/yyyy"
Set rs = Nothing
cn.Close
Set cn = Nothing
If b.Range("A2") <> Empty Then
MsgBox ("La busqueda se realizó con éxito"), vbInformation, "AVISO"
Else
MsgBox ("No se encontraron registros para el criterio de búsqueda"), vbInformation, "AVISO"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Como Enviar Whatsapp con Excel





Este post muestra un ejemplo denominado Como Enviar Whatsapp desde Excel, la macro utiliza la API oficial de Whatsapp para poder enviar un mensaje de Whatsapp desde Excel, pudiendo vincular Excel con Whatsapp.

Es preciso recordar que la macro trabaja con Whatsapp Web por ende es necesario activarlo antes, luego de ello se podrá enviar mensajes de Whatsapp desde Excel.

Esta macro se conecta con Chrome ya que Interner Explorer ni Edge no son compatibles con Whatsap Web, por ahora.

Desde el final del post se puede descargar el ejemplo en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad, Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.









 


Al descargar el ejemplo de macro llamada como Enviar Whatsapp con Excel, se puede observar un botón que permite mostrar un formulario o userform1 donde está cargada la macro para enviar Whasapp desde Excel.

El formulario presenta varios textbox chicos  que contienen un mensaje proforma o tipo plantilla y un textbox grande, haciendo doble click en los textbox chicos, automáticamente se carga en el textbox1  lo que tiene escrito el textbox plantilla en el cual hicimos doble click; pudiendo modificar el mensaje que se requiera enviar o simplemente se puede escribir directamente el mensaje de Whatsapp en el textbox1 o de mayor tamaño que se aprecia en el formulario.

Básicamente se necesita, para enviar Whatsapp desde Excel, el número de teléfono y el mensaje, esta aplicación permite enviar mensajes de texto Whatsapp a personas que no están registradas en nuestra agenda, basta con tener el número al cual enviaremos el mensaje, cargarlo en el textbox destinado a ingresar el número telefónico al que se le enviará mensaje.

El formulario contiene un buscador, de datos, en este caso se busca mediante SQL en una base de datos muy sencilla que está en la hoja1, a medida que se escribe se van mostrando los resultados existentes o concordantes con la cadena de texto que se va escribiendo simultáneamente en el textbox.

Los datos filtrados se muestran en un listbox oculto, el cual aparece unicamente cuando existan datos filtrados , haciendo click en el listbox más precisamente en el registro al cual se le requiere enviar un mensaje de Whatsapp desde Excel, el número de teléfono se agrega en el Textbox8, que es de donde se toma el número de teléfono para enviar el Whatsapp, solo resta escribir el mensaje o seleccionar de los mensajes maestros y preceder a enviar.


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Listbox dependiendo de otro listbox y combobox


Como crear un Msgbox en Excel

Listar archivos y cargarlo a un combobox

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Para enviar el Whatsapp desde Excel se debe presionar el botón con el logo de Whatsapp que se encuentre en el formulario, este botón primero guarda en una variable publica el número del teléfono y el texto en otra variable pública, esto es usado por la macro para saber el número del contacto y mensaje al que se le enviará el mensaje, luego llama a la macro para enviar el Whatsapp usando Excel.

La macro navega hasta el link de la API Whatsapp (Oficial de Whatsapp), al cual se debe conectar para poder enviar un mensaje, una vez que navegó hasta dicho link la macro usa el comando sendkey (quieres saber más sobre senkey sigue el link) para emitir o emular pulsaciones de tecla para poder lograr enviar el Whatsapp en forma automática desde Excel.

La macro emula tabulaciones y presión de la tecla ENTER, haciéndolo con el siguiente código

Application.Wait (Now + TimeValue("00:00:05"))
ActiveWindow.Application.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("00:00:01"))
ActiveWindow.Application.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("00:00:05"))
ActiveWindow.Application.SendKeys "(~)" 'énvia enter para enviar mensaje
Application.Wait (Now + TimeValue("00:00:18"))
ActiveWindow.Application.SendKeys "(~)"

Es preciso destacar que entre línea y línea de comando, la macro espera o hace una pausa de un par de segundos para luego continuar con el siguiente procedimiento de la macro, esto es así, porque se debe esperar que se cargue la página para emitir las pulsaciones de teclas.

El código completo de la macro denominada Como Enviar Whatsapp desde Excel se muestra a continuación y posterior a ello se encuentra el link para descargar el ejemplo proporcionado en ese post.


Código que se inserta en un módulo

Public telwhatsapp, textwhatsapp
Sub Muestra()
UserForm1.Show
End Sub
Sub EnviaWhatsapp()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

If telwhatsapp = Empty Or textwhatsapp = Empty Then
MsgBox ("Debe ingresar número de telefono y texto para enviar Whatsapp"), vbCritical, "AVISO"
Exit Sub
End If

mylinkwhatsapp = "https://api.whatsapp.com/send?phone=" & telwhatsapp & "&text=" & textwhatsapp
ActiveWorkbook.FollowHyperlink mylinkwhatsapp

Application.Wait (Now + TimeValue("00:00:05"))
ActiveWindow.Application.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("00:00:01"))
ActiveWindow.Application.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("00:00:05"))
ActiveWindow.Application.SendKeys "(~)" 'énvia enter para enviar mensaje
Application.Wait (Now + TimeValue("00:00:18"))
ActiveWindow.Application.SendKeys "(~)"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Código que se inserta en un formulario


Private Sub CommandButton1_Click()
telwhatsapp = UserForm1.TextBox8
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp
End Sub


Private Sub ListBox3_Click()
On Error Resume Next
ctlsaltachange = 1
UserForm1.TextBox8 = Empty
fila = UserForm1.ListBox3.ListIndex
UserForm1.TextBox8 = UserForm1.ListBox3.List(fila, 1)
UserForm1.TextBox9 = UserForm1.ListBox3.List(fila, 0) & " " & UserForm1.ListBox3.List(fila, 1) & " " & UserForm1.ListBox3.List(fila, 2)


UserForm1.ListBox3.Visible = False

If TextBox9 = Empty Then
UserForm1.Label2.Visible = True 'hace visible el label
Else
UserForm1.Label2.Visible = False
End If

If TextBox8 = Empty Then
UserForm1.Label1.Visible = True 'hace visible el label
Else
UserForm1.Label1.Visible = False
End If

ctlsaltachange = 0
End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = TextBox2
End Sub
Private Sub TextBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = TextBox3
End Sub

Private Sub TextBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
TextBox1 = TextBox4
End Sub

Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = "Expte: " & UserForm1.TextBox2 & " Caratula " & UserForm1.TextBox3
TextBox1 = TextBox5
End Sub

Private Sub TextBox6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = "Expte: " & UserForm1.TextBox2 & " Caratula " & UserForm1.TextBox3
TextBox1 = TextBox6
End Sub

Private Sub TextBox7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = "Expte: " & UserForm1.TextBox2 & " Caratula " & UserForm1.TextBox3
TextBox1 = TextBox7
End Sub

Private Sub TextBox8_Change()
If TextBox8 = Empty Then
UserForm1.Label1.Visible = True 'hace visible el label
Else
UserForm1.Label1.Visible = False
End If
End Sub


Private Sub TextBox9_Change()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim cn As ADODB.Connection, rs As ADODB.Recordset

'If ctlsaltachange = 1 Then Exit Sub

If TextBox9 = Empty Then
UserForm1.Label2.Visible = True 'hace visible el label
Else
UserForm1.Label2.Visible = False
End If

If Len(UserForm1.TextBox9) <= 2 Then
UserForm1.ListBox3.Visible = False
Exit Sub
Else
UserForm1.ListBox3.Visible = True
End If

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set a = Sheets("Hoja1")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;"""

If Len(UserForm1.TextBox9) > 2 Then
sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("A1") & ") LIKE Ucase('%" & UserForm1.TextBox9 & "%') ORDER BY Nombre ASC"
Set rs = cn.Execute(sql)

UserForm1.ListBox3.Clear

Set rs = cn.Execute(sql)
If rs.EOF = True Then
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
UserForm1.ListBox3.Visible = False
Exit Sub
Else

UserForm1.ListBox3.Column = 3
UserForm1.ListBox3.ColumnWidths = "100 pt;70 pt;80 pt"

rs.MoveFirst
Do While Not rs.EOF
    UserForm1.ListBox3.AddItem rs.Fields(0).Value
    UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 1) = rs.Fields(1).Value
    UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 2) = rs.Fields(2).Value
   ' Userform1.ListBox3.List(Userform1.ListBox3.ListCount - 1, 3) = rs.Fields(4).Value
   ' Userform1.ListBox3.List(Userform1.ListBox3.ListCount - 1, 4) = rs.Fields(5).Value
   ' Userform1.ListBox3.List(Userform1.ListBox3.ListCount - 1, 5) = rs.Fields(6).Value
    rs.MoveNext
Loop
End If

End If
Set rs = Nothing
cn.Close
Set cn = Nothing

'Si solo hay un dato coincidente directamente lo busca y carga sus datos, al seleccionarlo se ejecuta el evento click del listbox
If UserForm1.ListBox3.ListCount - 1 = 0 Then
'El código 1 salta la programacion del evento change del combobox16 porque sino cuando la macro modifica se vuelve a ejecutar y se obtiene resultado no deseado
'saltacbo16 = 1
'La macro al seleccionar el item autoaticamente ejecuta la programacion del evento click que es la busqueda del dato y que
'es lo que interesa en esta programación, por eso no se llama luego al evento listbox_click sino se ejecuta dos veces.
UserForm1.ListBox3.Selected(0) = True
'Call ListBox3_Click
UserForm1.ListBox3.Visible = False
'Se hace perder el foco al combobox16, porque sino se ejecuta la codificación del After_Update
'Userform1.TextBox2.SetFocus
End If
'salir:
'Vuelve la variable a estado 0 para que se pueda ejecutar el evento change con otro registro
'saltacbo16 = 0
Application.ScreenUpdating = True
Application.ScreenUpdating = True

End Sub
Private Sub UserForm_Initialize()
ExpteWhatsapp = "SUSCRIBE https://www.youtube.com/c/programarexcel?sub_confirmation=1"
UserForm1.TextBox1 = ExpteWhatsapp
UserForm1.TextBox2 = "Estimado recuerda " & ExpteWhatsapp & " activa la campanita y YouTube te avisara cuando se suba nuevo contenido "
UserForm1.TextBox3 = "Automatiza tus Libros Excel, tutoriales semanales, recuerda " & ExpteWhatsapp & " todas las semanas ideas sobre como automatizar tus libros Excel "
UserForm1.TextBox4 = "Mis datos son:" & Chr(13) & " https://www.youtube.com/c/programarexcel?sub_confirmation=1 " & Chr(13) & " comenta, dale LIKE si te fue útil"
UserForm1.TextBox5 = "Recuerda darle LIKE Y COMENTAR SI FUE UTIL: " & Chr(13) & "RECUERDA " & ExpteWhatsapp
UserForm1.TextBox6 = "Su próxima factura de ProgramarExcel.com vence el: " & Chr(13) & "14/06/2020 "
UserForm1.TextBox7 = "https://programarexcel.com Descarga cientos de ejemplos de Macros de Excel GRATIS, aporta al canal si puedes, sino con like, comentario y suscripción es suficiente"
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Conectar Excel con Excel Consulta SQL Un Criterio con Datos Otro Libro





El ejemplo que se presenta a continuación permite Filtrar Datos de Excel en Base a Criterio donde la Base de Datos está en Otro Libro distinto en el cual estamos trabajando, la búsqueda y extracción de datos se realiza utilizando una conexión ADODB - OLEDB, combinando VBA y SQL, es decir se filtran datos mediante sentencias SQL.

Desde el final del post se puede descargar el ejemplo en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad, Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.









   


Para una mejor compresión debes descargar y descomprimir el archivo rar de ejemplo, al descomprimir puedes guardar en cualquier directorio de la PC, la única condición es que estén los dos archivos en el mismo directorio, porque el archivo con la macro buscará los datos en el libro que contiene la base de datos.

Presionando el botón se ejecuta una macro que conecta el libro de Excel que contiene la macro de Excel con el libro que contiene la base de datos, lograda esa conexión a través de una sentencia SQL se logra filtrar los datos, teniendo presente que no se abre el libro de Excel con la base de datos, los datos pueden ser obtenidos por la conexión establecida, dicha conexión se realiza con el siguiente código, en la variable mybook se guarda la dirección del archivo con la base de datos.

mybook = ThisWorkbook.Path & "\414 Conectar Excel con Excel Consulta SQL Base Datos.xlsx"

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & mybook & ";Extended Properties=""Excel 12.0;HDR=Yes;"""

Realizada la conexión se debe realizar la consulta SQL o string de consulta que también se le denomina de la siguiente forma:

sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('%" & Range("H2") & "%') ORDER BY ID ASC"

En el caso anterior la SQL filtra todos los registros de la hoja1 con la condición que el campo "Marca" sea igual al valor ingresado en la cela H2, no solo filtra los valores que coinciden plenamente no lo ingresado sino todos aquellos registros que contengan en la cadena de texto del registro "Marca" el texto ingresado en H2, ejemplo si se ingresa la marca ARCOR, buscará en la columna "Marca" todo lo que contenga la cadena de caracteres ARCOR, es decir buscará por ejemplo ARCOR, ARCOR GALLETAS, etc.

La siguiente SQL se usa cuando se tilde el casillero del checkbox, donde se expresa que se requiere solo se filtren la coincidencias exactas, extrayendo los datos que coinciden exactamente con la cadena de texto ingresada en H2, es decir solo extraerá la coincidencia iguales a la cadena ingresada.

sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('" & Range("H2") & "') ORDER BY ID ASC"

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como buscar archivos en una carpeta y hacer link al fichero


Como truncar o cortar el nombre de un archivo a una cantidad especifica de caracteres

Como pasar datos de un listbox a otro con Enter

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Para ejecutar la SQL se usa:

Set rs = cn.Execute(sql)

Para grabar los datos obtenidos al ejecutar la SQL, que están contenidos en memoria, se usa el siguiente código:

b.Cells(2, 1).CopyFromRecordset Data:=rs

El ejemplo de macro que permite filtrar por un criterio con SQL estando la base de datos en otro libro, se puede descargar desde el final del post, a continuación se expone el código completo que contiene el ejemplo que se descarga.

Código que se inserta en un módulo

Sub ConsutaSQLExcel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ctl As Object
Dim cn As ADODB.Connection, rs As ADODB.Recordset, sql As String
On Error Resume Next
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set a = Sheets("Hoja1")
Set b = Sheets("Hoja2")


mybook = ThisWorkbook.Path & "\414 Conectar Excel con Excel Consulta SQL Base Datos.xlsx"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & mybook & ";Extended Properties=""Excel 12.0;HDR=Yes;"""

If a.CheckBox1 = False Then
sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('%" & Range("H2") & "%') ORDER BY ID ASC"
Else
sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('" & Range("H2") & "') ORDER BY ID ASC"
'sql = "SELECT * FROM [" & "Hoja1$A1:V65000" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('" & Range("H2") & "') ORDER BY ID ASC"
End If

b.Cells.Clear
a.Range("A1:G1").Copy Destination:=b.Range("A1")
Set rs = cn.Execute(sql)
b.Cells(2, 1).CopyFromRecordset Data:=rs
b.Range("B:B").NumberFormat = "dd/mm/yyyy"
Set rs = Nothing
cn.Close
Set cn = Nothing
If b.Range("A2") <> Empty Then
MsgBox ("La busqueda se realizó con éxito"), vbInformation, "AVISO"
Else
MsgBox ("No se encontraron registros para el criterio de búsqueda"), vbInformation, "AVISO"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Conectar Excel con Excel Consulta SQL Un Criterio con Datos Mismo Libro





El ejemplo que se presenta es una macro que muestra como conectar Excel con Excel y Buscar Datos en Base a Criterio con SQL, estando los datos contenidos en el mismo libro, la consulta se realiza sin abrir el otro libro de Excel

Descarga el ejemplo en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad, Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.








 


Después de descargar el archivo podrás observar un botón, presionando el mismo se ejecuta la macro, la macro busca el dato de la celda H2 en la columna "Marca", cuyo nombre está en la celda H1, es variable así que se puede poner cualquier otro nombre de cabecera de columnas.

También su puede buscar una coincidencia exacta si se hace click en el checkbox o cualquier palabra que contenga la palabra escrita en la celda H2, para buscar los datos se combina VBA con SQL, para ello se debe realizar la conexión Excel con Excel con el siguiente código, aclarando que se usa Excel 365 / 2016.

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;"""

Luego se crea la SQL, que es el string de consulta, que luego se ejecuta para filtrar los datos dependiendo del criterio, es la siguiente dependiendo de si se requiere una coincidencia exacta o que la palabra contenga la cadena de texto de la celda H2:

Coincidencia no exacta es decir la palabra puede coexistir con otras cadenas de caracteres

sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('%" & Range("H2") & "%') ORDER BY ID ASC"

Coincidencia exacta, solo filtra los registros que coincidan en forma exacta con lo escrito.

sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('" & Range("H2") & "') ORDER BY ID ASC"



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como crear una factura con excel, guardarla y enviarla por mail automáticamente


Como enviar mail con archivo Excel y PDF mediante Outlook con Excel

Como hacer un link o hiperlink a google maps con Excel

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

La consulta de datos se realiza con el siguiente código, con este código se filtran los datos según el criterio y se mantienen en memoria, Recordset.

Set rs = cn.Execute(sql)

Para escribir o pegar los datos filtrados en el Hoja del Libro de Excel se usa el siguiente código, en este caso se pegan en la hoja2 a partir de la celda A2.

b.Cells(2, 1).CopyFromRecordset Data:=rs


Luego la macro determina si existen datos en dicho rango, en caso positivo se encontraron datos y sale un mensaje en caso que no se hayan encontrado datos, sale otro mensaje distinto, esto se hace con msgbox (si quieres saber más sobre msgbox sigue el link)

Para terminar se aconseja conectar con el libro ejecutar la sql, lo más cercano posible al momento de usar los datos y luego liberar las variables, por el simple hecho que consume recursos (Memoria de la PC), entonces se debe realizar la consulta en el preciso momento de usar los datos, usarlos y liberar las variables y cerrar la conexión así:

Set rs = Nothing
cn.Close
Set cn = Nothing

El código completo se encuentra a continuación y posteriormente está el link de descarga del ejemplo Conectar Excel con Excel Busqueda  en Base a Criterios con SQL con Dtos en el Mismo Libro.


Código que se inserta en un módulo

Sub ConsutaSQLExcel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ctl As Object
Dim cn As ADODB.Connection, rs As ADODB.Recordset, sql As String
On Error Resume Next
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set a = Sheets("Hoja1")
Set b = Sheets("Hoja2")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;"""

'uf = a.Range("A" & Rows.Count).End(xlUp).Row
If a.CheckBox1 = False Then
sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('%" & Range("H2") & "%') ORDER BY ID ASC"
Else
sql = "SELECT * FROM [" & "Hoja1$" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('" & Range("H2") & "') ORDER BY ID ASC"
'sql = "SELECT * FROM [" & "Hoja1$A1:V65000" & "] WHERE Ucase(" & a.Range("H1") & ") LIKE Ucase('" & Range("H2") & "') ORDER BY ID ASC"
End If

b.Cells.Clear
a.Range("A1:G1").Copy Destination:=b.Range("A1")
Set rs = cn.Execute(sql)
b.Cells(2, 1).CopyFromRecordset Data:=rs
b.Range("B:B").NumberFormat = "dd/mm/yyyy"
Set rs = Nothing
cn.Close
Set cn = Nothing
If b.Range("A2") <> Empty Then
MsgBox ("La busqueda se realizó con éxito"), vbInformation, "AVISO"
Else
MsgBox ("No se encontraron registros para el criterio de búsqueda"), vbInformation, "AVISO"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends