Como SUPRIMIR VARIOS registros de Listbox MULTISELECT a la Vez con ENTER
En este post se muestra una macro de Excel VBA que permite eliminar varios items de un Listbox Multiselect a la vez o en simultaneo al presionar ENTER, se requiere que se seleccione el o los elementos del listbox que se desean quitar o eliminar y se presione ENTER, de esta manera se quitarán todos los elementos seleccionados del Listbox Multiselect de Excel VBA.
Requieres mejorar tu manejo de planillas de cálculos de Excel, 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, te lo recomiendo no te arrepentirás.
En 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 nuestro canal de You Tube, mira el playlist con vídeos relacionados donde podrás ver la macros relacionadas en acción con una explicación en forma visual que ayudará a entender el ejemplo en forma más fácil.
Quitar Registros de un LISTBOX MULTISELECT VBA
Primero se debe descargar el libro de Excel que se usa de ejemplo, lo cual se podrá hacer del link que figura al final del post, al ingresar al libro de Excel se observará un botón verde, presionando el mismo se mostrará un formulario con un Listbox Multiselect.
El Listbox Multiselect se rellena con los datos que figuran en la hoja de Excel llamada Hoja 1 , para eliminar o quitar filas del Listbox, bastará solamente con marcar la o las filas que se requiera eliminar del Listbox de Excel VBA y presionar ERNTER, obteniendo como resultado que se quiten en forma simultanea todas las filas seleccionadas.
Es preciso recordar que solo se eliminan del Listbox Multiselect no de la hoja de Excel, si quieres saber como eliminar registros de la hoja de Excel también haz click en el link
Quizás también interese leer:
Como Eliminar Filas en Base a Color de Celda
Como Eliminar Filas con Formato Negrita
Como Eliminar Filas que Contengan Formulas
Si quieres aprender más sobre listbox de excel o ver otros ejemplos que podrías aplicar a tus proyectos te invito a ver el playlist sobre Listbox de Excel.
Explicación del código QUITAR filas de Listbox Multiselect con ENTER
El código detecta cuando se presiona ENTER para ejecutar la macro, la macro consiste en recorrer todas las filas del listbox determinando cual está resaltada, marcada o seleccionada, procediendo a eliminar dicha fila, se recorren las filas del Listbox desde el Final hacia el principio del listbox, sin incluir la fila cero que es donde están los encabezados.
Para detectar cuando se presiona ENTER, la macro se tiene que colocar en el evento KeyPress del Listbox, luego comparar si la tecla presionada es igual a 13, en el código Ascii, ENTER, es representada por el número 13, el código usado es el siguiente:
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 13 Then
Una vez seleccionados los items o filas a eliminar y detectado que se presionó Enter se procede a realizar un bucle entre la última fila del Listbox y la fila 1 del Listbox de Excel, determinando que filas están resaltadas, se usa el siguiente código:
For x = Me.ListBox1.ListCount – 1 To 1 Step -1
If a.Selected(x) = True Then
Determinadas las filas resaltadas, en forma simultanea a medida que se ejecuta el bucle se van eliminando las celdas del listbox, con el siguiente código:
a.RemoveItem x
Descarga el ejemplo llamado como registros de Listbox Multiselect con ENTER en forma Fácil
Si deseas descargar el Libro Excel que se usa de ejemplo, lo podrá hacer desde el final del post, es totalmente Gratis y no tiene ningún tipo de restricción, solicito aportar a sostener la esta web si está dentro de tus posibilidades, desde ya muchas gracias.
Código que se encuentra en el modulo
Sub muestra1()
UserForm1.Show
End Sub
Código que se Encuentra en Formulario 3
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = UserForm1.ListBox1
For x = Me.ListBox1.ListCount – 1 To 1 Step -1
If a.Selected(x) = True Then
a.RemoveItem x
End If
Next x
End If
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets(«Hoja1»)
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 = «Hoja1!A2:D» & uf
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)
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets(«Hoja1»).Cells(1, ii + 1)
Next ii
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 1).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)
End If
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets(«Hoja1»).Cells(1, ii + 1)
Next ii
Me.ListBox1.ColumnWidths = «20 pt;90pt;80 pt;80 pt»
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets(«Hoja1»)
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 = «Hoja1!A2:H» & uf
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)
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets(«Hoja1»).Cells(1, ii + 1)
Next ii
Exit Sub
End If
If Len(TextBox2) > 2 Then
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 2).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
‘Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets(«Hoja1»).Cells(1, ii + 1)
Next ii
Me.ListBox1.ColumnWidths = «20 pt;90pt;80 pt;80 pt»
End If
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets(«Hoja1»)
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 = 4
.ColumnWidths = «20 pt;90pt;80 pt;80 pt»
‘.RowSource = «Hoja2!A2:» & wc & uf
End With
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
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)
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets(«Hoja1»).Cells(1, ii + 1)
Next ii
Application.DisplayAlerts = True
Application.ScreenUpdating = 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.
Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407
