PROGRAMAR EN VBA MACROS PARA EXCEL: septiembre 2018

Como Eliminar Item al Pasar Datos Listbox a Otro Listbox con Enter






En este ejemplo se muestra como pasar item de un listbox a otro e ir eliminando el registro del listbox, es decir al presionar enter se pasaran los datos del primer al segundo listbox y se eliminará el registro del primer listbox.

Si estás trabajando con listbox quizás quieras aprender más sobre este objeto de VBA para Excel, en el link encontrarás muchos ejemplos que serán de utilidad relacionados con listbox de Excel.

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.

  

Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.






 


Al descargar el ejemplo se podrá observar un botón, presionando el mismo se muestra un formulario con dos listbox uno debajo de otro denominados listbox 1 y listbox 2 respectivamente.

La macro básicamente funciona así: al seleccionar un ítem del Listbox 1, que es el Listbox que está arriba del formulario de Excel, se ejecuta una macro al presionar Enter, que permite pasar todo el registro seleccionado al Listbox 2 o el Listbox que está debajo en el formulario de Excel.



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

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



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

El evento que permite pasar un item de un listbox a otro es el KeyPress, es decir cuando se presiona una tecla, pero no cualquier tecla sino la tecla enter, para ello a través de la tabla de código Ascci se detecta cuando se presiona enter, que es representada por el N° 13 en dicha tabla.

Una vez presionado Enter se establece cual es la fila del Listbox seleccionada o ítem seleccionado y se carga en una variable el N° de fila, con el siguiente código:

fila = UserForm1.ListBox1.ListIndex

Posterior a ello se pasan los datos de un Listbox a otro Listbox, una vez que se trasladaron todos los datos de la fila de un Listbox al otro se procede a remover, eliminar o borrar el ítem seleccionado en el primer Listbox, eso se hace con el siguiente código:

a.RemoveItem a.ListIndex

Seguidamente se muestra el código completo incluido en todo el formulario que se proporciona con el ejemplo llamado Como Eliminar Item al Pasar Datos de Un Listbox a Otro Listbox, en forma posterior está el Link de descarga.


Código que se inserta en un Formulario de Excel

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********


Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
Set a = UserForm1.ListBox1
Set b = UserForm1.ListBox2
If KeyAscii = 13 Then
fila = UserForm1.ListBox1.ListIndex
b.AddItem a.List(fila, 0)
b.List(b.ListCount - 1, 1) = a.List(fila, 1)
b.List(b.ListCount - 1, 2) = a.List(fila, 2)
b.List(b.ListCount - 1, 3) = a.List(fila, 3)
b.List(b.ListCount - 1, 4) = a.List(fila, 4)
b.List(b.ListCount - 1, 5) = a.List(fila, 5)
b.List(b.ListCount - 1, 6) = a.List(fila, 6)
b.List(b.ListCount - 1, 7) = a.List(fila, 7)
a.RemoveItem a.ListIndex
End If
End Sub


Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
     'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
     Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 3).Value
   If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
   End If
Next i
Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = "" Then
     'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
     Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 4).Value
   If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
   End If
Next i
Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
    .ColumnCount = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
    '.RowSource = "Hoja2!A2:" & wc & uf
End With
With Me.ListBox2
    .ColumnCount = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End With

uf = b.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To uf
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



Código que se inserta en un módulo

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********

Sub muestra1()
UserForm1.Show
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 Pasar Datos a Hoja Excel Desde Listbox con Enter y Doble Click Indistintamente






En el post existe una macro que muestra Como Pasar Datos de Listbox a Hoja de Excel con Enter o Doble Click en Forma Indistinta, es decir el usuario podrá pasar los datos presionando la tecla Enter o Doble Click lo que le quede más cómodo.

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 lograr que los datos se pasen desde un listbox a una hoja de Excel ya sea con Enter o Doble Click, es decir de cualquiera de las dos formas, la macro básicamente es la misma, debiendo en el caso de querer pasar los datos con enter, escribir el código en el evento Keypress del listbox, de la siguiente forma:

Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

En el caso que se requiera utilizar doble click para pasar los datos a la hoja de Excel desde el Listbox, se debe utilizar el evento doble click del Listbox, de la siguiente forma:

ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)


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

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



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

En el caso de utilizar Enter, como el evento es el KeyPress, es decir cuando se presiona una tecla, primero se debe determinar que la tecla presionada es "Enter", para ellos se usa la tabla de códigos Ascii, en dicha tabla el 13 representa a la tecla Enter.

Entonces, se debe detectar que la tecla presionada es Enter en primer lugar para que la macro se ejecute, el código es el siguiente:

If KeyAscii = 13 Then

Luego de establecer que la tecla presionada es Enter el código a ejecutar es el que pasa los datos del Listbox a Excel, cada fila y columna del Listbox se pasan a las respectivas filas y columnas de Excel, es necesario detectar que ítem ha sido seleccionado eso se hace con la primer linea siguiente:

fila = Me.ListBox1.ListIndex

a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
a.Cells(filaedit, "C") = ListBox1.List(fila, 2)

Seguidamente se encuentre el código completo del ejemplo denominado Como Pasa Datos a Hoja Excel Desde Listbox con Enter o Doble Click, seguidamente se podrá descargar el ejemplo que no tiene restricción alguna.
.

Código que se inserta en un Formulario de Excel

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = Sheets("Hoja1")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
a.Cells(filaedit, "H") = ListBox1.List(fila, 7)
End If
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Set a = Sheets("Hoja1")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
a.Cells(filaedit, "H") = ListBox1.List(fila, 7)

End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
     'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
     Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 3).Value
   If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
   End If
Next i
Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = "" Then
     'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
     Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 4).Value
   If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
   End If
Next i
Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
    .ColumnCount = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
    .RowSource = "Hoja2!A2:" & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



Código que se inserta en un módulo

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********

Sub muestra1()
UserForm1.Show
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 Espaciar los Registros en Listbox de Excel






En este post se presenta un ejemplo muy simple a pedido de un suscriptor de nuestro canal de youtube, quien planteaba si era posible espaciar las filas donde se registran los items de un listbox, este ejemplo muestra como dar un aspecto de espaciado entre las filas del listbox de Excel.


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.









 



La codificación que modifica las propiedades del listbox se encuentran en el evento Initialize del Formulario que contienen los listbox.

Si bien la codificación del Formulario es mas grande ya que incluye un buscador, que va filtrando y mostrando en listbox a medida que se escribe, no se explicará en ese ejemplos solo se deterndrá en la modificación de las propiedades del listbox para dar un efecto de mayor espaciado entre las lineas o filas del listbox.

Los ejemplos 177, 178 ,184, 320 , 348 etc. explican en detalle como se puede filtrar datos y mostrar las coincidencias a medida que se escribe, sugiero que los revisen, en el siguiente link encontrarás más sobre listbox de excel.


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

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



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

En el evento Initialize del formulario se agregan los códigos necesarios para poder cambiar las propiedades de los listbox, en este caso la codificación es la siguiente:

With Me.ListBox2
    .ColumnCount = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
    .RowSource = "Hoja2!A2:" & wc & uf
    .ListStyle = fmListStyleOption
    .ForeColor = &HFFFF80
    .Font.Size = 10
End With

El primer código establece la cantidad de columnas del listbox, el siguiente el ancho de las columnas que componen el listbox; posteriormente se establece el origen de donde se cargan los datos; con ListStyle, se logra dar un aspecto de opciones, es decir a cada linea del listbox al principio se agrega un boton de opciones, ello permite espaciar un poco las lineas del listbox, pero también se puede aumentar el tamaño de la fuente para dar sensación de espaciado entre los itemdel listbox.

A continuación se encuentra el código completo que permite dar espaciado entre las filas de un listbox, seguidamente está el link de descarga del archivo de ejemplo, considera la posibilidad de aportar para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

Código que se inserta en un Formulario


'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********


Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = Sheets("Hoja1")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
a.Cells(filaedit, "H") = ListBox1.List(fila, 7)
End If
End Sub

Private Sub ListBox2_Click()

End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
     'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
     Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 3).Value
   If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
   End If
Next i
Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = "" Then
     'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
     Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 4).Value
   If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
   End If
Next i
Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Hoja2")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
    .ColumnCount = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
    .RowSource = "Hoja2!A2:" & wc & uf
End With

With Me.ListBox2
    .ColumnCount = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
    .RowSource = "Hoja2!A2:" & wc & uf
    .ListStyle = fmListStyleOption
    .ForeColor = &HFFFF80
    .Font.Size = 10
End With



Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Código que se inserta en un módulo


'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********

Sub muestra1()
UserForm1.Show
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 Filtrar Datos Excel con Consulta SQL Vs Bucle While Wend





En este post se presenta una comparación entre macros, se muestra por un lado una macro que permite filtrar datos mediante criterios utilizando un Bucle con la estructura While ... Wend y por otro lado se usa SQL para buscar datos en Excel, los resultados son los mismos, en base de datos chicas el tiempo de búsqueda es prácticamente el mismo, pero en bases de datos más grandes SQL es mucho más rápido.

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.

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.

  

Mira una explicación detallada en el vídeo, 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 y abrir el libro de Excel se podrá observar que se encuentran dos botones, el primero ejecuta un filtro o búsqueda utilizando un bucle con la estructura While...Wend; el segundo botón realiza la misma búsqueda o filtro de datos utilizando SQL.

Los criterios de búsqueda se encuentran en la Hoja1 celda B1 y Celda E1, en el ejemplo que se muestra se busca todos los datos coincidentes en la base de datos que se encuentra en la Hoja2, que sena iguales a la marca "Coca Cola" cuyo precio de venta (Pv) sea mayor a "Cinco".

Con el bucle While... When, se recorre todas las filas buscando los registros que coincidan con los criterios, en este ejemplo los criterios se asignan a variables que son las siguientes:

marca = UCase(b.Range("B1"))
signo = b.Range("D1")
valor = b.Range("E1")

marcabus = UCase(a.Cells(filabus, "D"))
valorbus = a.Cells(filabus, "E")


Las primeras variables son las de la hoja de destino y las últimas dos variables son los datos que va tomando cada vez que se recorra las filas con el bucle While ... Wend

Si la marca ingresada en B1 es coincidente con la marca de la fila correspondiente de la Hoja2 que en cada momento recorre el bucle y además el valor de venta es mayor al valor buscado, entonces el registro cumple la condición, lo copia y pega en la Hoja1 y así sucesivamente con cada uno de los ítem de la base de datos.

If marcabus = marca And valorbus > valor Then
a.Range("A" & filabus & ":G" & filabus).Copy Destination:=b.Range("A" & fila)

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

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


Como cargar listbox con datos provenientes de varias hojas

Como repetir en Excel un mismo caracter varias veces

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



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

La otra forma de búsqueda es el Filtro de Datos de Excel a través de SQL, para ello primero hay que realizar una conexión con el Libro Excel, que puede ser el mismo u otro libro, en este caso es el mismo, ya que los datos se encuentran en el mimos libro sobre el cual se trabaja.

La conexión con el mismo libro se realiza con el siguiente código, a continuación la SQL, que es el string de consulta que contiene los criterios de búsqueda o filtro de datos.

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

sql = "SELECT * FROM [" & "Hoja2$" & "] WHERE Ucase(" & a.Range("D1") & ") LIKE Ucase('%" & b.Range("B1") & "%') AND pv " & b.Range("D1") & " " & b.Range("E1") & " ORDER BY pv ASC"

La SQL se podría leer: Selecciones todas las columnas de la Hoja2 cuando la columna Marca coincida con el texto (marca) ingresado en B1 y el precio de venta sea Mayor al precio que figura en la columna "Pv" de la base de datos.

Una vez ejecutada la SQL los datos filtrados o coincidentes se mantienen en memoria (Recorset), hasta tanto sean usado y liberadas las variables.

Set rs = cn.Execute(sql)
b.Cells(3, 1).CopyFromRecordset Data:=rs

En el código anterior los datos filtrados son copiados a partir de la fila 1 columna 1 es decir celda A3, ya que en la fila 2 van los encabezados de columna.

Para liberar las variables y por ende liberar recursos, se usa:

Set rs = Nothing
cn.Close
Set cn = Nothing


El ejemplos denominado Como Filtrar Datos Excel con Consulta SQL vs. Bucle While ... Wend, se puede descargar desde el link del final que esta en forma posterior a la codificación del ejemplo que se encuentra a continuación.


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 b = Sheets("Hoja1")
Set a = Sheets("Hoja2")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;"""
sql = "SELECT * FROM [" & "Hoja2$" & "] WHERE Ucase(" & a.Range("D1") & ") LIKE Ucase('%" & b.Range("B1") & "%') AND pv " & b.Range("D1") & " " & b.Range("E1") & " ORDER BY pv ASC"

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

Sub ConsutaBucleWhileWend()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'On Error Resume Next
Set b = Sheets("Hoja1")
Set a = Sheets("Hoja2")
filabus = 2
fila = 3
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If uf < 3 Then uf = 2
b.Range("A3:G" & uf).Clear
a.Range("A1:G1").Copy Destination:=b.Range("A2")

While a.Cells(filabus, "A") <> Empty
marca = UCase(b.Range("B1"))
signo = b.Range("D1")
valor = b.Range("E1")

marcabus = UCase(a.Cells(filabus, "D"))
valorbus = a.Cells(filabus, "E")
If marcabus = marca And valorbus > valor Then
a.Range("A" & filabus & ":G" & filabus).Copy Destination:=b.Range("A" & fila)
fila = fila + 1
End If
filabus = filabus + 1
Wend

b.Range("B:B").NumberFormat = "dd/mm/yyyy"
If b.Range("A3") <> Empty Then
MsgBox ("La busqueda se realizó con éxito"), vbInformation, "AVISO"
Else
MsgBox ("No se encontraron regisgros 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