Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL

Como ELIMINAR Varios ITEM de LISTBOX y HOJA de EXCEL a la Vez Con ENTER #515

Eliminar Item de Listbox y Hoja de Excel

Suprimir Varios Item de Listbox Multiselect y Hoja de Excel a la Vez

En este post fue creado a pedido de un suscriptor de nuestro canal de You Tube, se muestra como Quitar Elementos de un Listbox Multiselect y de la Hoja de Excel a la vez.

Aprende a manejar Excel en forma fácil, 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.

  
 

Mira el funcionamiento de la macro y 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 Elementos de Listbox Multiselect y Hoja Excel con Enter

Al abrir el archivo de ejemplo se observa un botón color verde, presionando el mismo se muestra un formulario con un listbox, que carga los datos de la Hoja.

El listbox es multiselect, es decir se pueden seleccionar varios items a la vez, seleccionados los elementos que deseamos suprimir, se eliminan del listbox y de la hoja de Excel en forma simultanea o a la vez.

La macro detects cuando se presiona Enter, una vez seleccionados los elementos a quitar se procede, solo en el caso de haber presionado ENTER, a quitar los elementos del Listbox Multiselect, a la vez que lo hace de la hoja de Excel.

Explicación del código para Suprimir Elementos del Listbox Multiselect y Hoja de Excel

Para poder quitar elementos del listbox multiselect y de la hoja de cálculo de Excel, se debe ingresar el código en el evento keypress del Listbox1, en primer lugar a través del código Ascii se detecta en número correspondiente en dicha tabla y que representa la pulsación de la tecla ENTER, siendo en 13, como se decir la macro detecta si se presionó ENTER y ejecuta el procedimiento, con el siguiente código:

If KeyAscii = 13 Then

Luego se hace un bucle recorriendo de abajo hacia arriba todas las filas del Listbox, son el siguiente código:
For x = Me.ListBox1.ListCount – 1 To 1 Step -1

Si el ítem del listbox esta seleccionado se procede a detectar la fila del listbox donde está el registro y lo elimina  antes de ello recupera el dato de la fila a eliminar con el ID del registro, ello nos sirve para buscar en la Hoja de Excel dicho registro y eliminarlo o quitarlo de la planilla de cálculo, se usa el siguiente código:

If a.Selected(x) = True Then
cod = UserForm1.ListBox1.List(x, 0)
a.RemoveItem x

Luego se busca en la Hoja de Excel el ID del registro  o los registros eliminados en el Listbox, procediendo a suprimirlos de la Hoja de cálculo, con el código que se muestra a continuación.

Set codigo = b.Range(«A2:A» & uf).Find(cod, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
Dire = codigo.Row
b.Cells(Dire, «A»).EntireRow.Delete
End If

Descarga del archivo ejemplo usado para la macro Como Eliminar Varios Item de Listbox y de la Hoja de Excel simultáneamente

Baja el archivo de ejemplo en forma gratis desde el final del post, solicito aportar para sostener esta web, si está dentro de tus posibilidades, desde ya muchas gracias.

Código para Eliminar Items de Listbox Multiselect y Hoja de Excel a la vez

Código que se ingresa en un Userform

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = UserForm1.ListBox1
Set b = Sheets(«Hoja1»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row

For x = Me.ListBox1.ListCount – 1 To 1 Step -1
If a.Selected(x) = True Then
cod = UserForm1.ListBox1.List(x, 0)
a.RemoveItem x
‘a.Refresh

Set codigo = b.Range(«A2:A» & uf).Find(cod, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
Dire = codigo.Row
b.Cells(Dire, «A»).EntireRow.Delete
End If

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

Código que se ingresa en el modulo

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.

Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407

Summary
Author Rating
1star1star1star1star1star
Aggregate Rating
no rating based on 0 votes