PROGRAMAR EN VBA MACROS PARA EXCEL: Como Copiar y Eliminar Item al Pasar de Listbox a Otro Listbox con Enter y Viceversa

Como Copiar y Eliminar Item al Pasar de Listbox a Otro Listbox con Enter y Viceversa







En este ejemplo se verá Como Pasar Datos de un Listbox a Otro y Viceversa con Enter, es decir se muestra como se pueden pasar datos al presionar enter de un Listbox a otro Listbox , los datos que se van pasando se copian en el segundo Listbox y en el primer Listbox se borra el item.

En caso que se requiera revetir la operación es decir pasar datos del segundo Listbox al primer Listbox , al presionar Enter en esté último Listbox se pasa el dato al primer Listbox y se borra el item en del segundo Listbox.

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.






 


Se aconseja descargar el ejemplo para su más fácil y rápido entendimiento, al abrir el libro se observa un botón que presionando muestra un formulario que básicamente contiene dos listbox uno con fondo blanco Listbox1 y otro con fondo celeste Listbox2.

Al seleccionar un ítem y presionar Enter en el Listbox1 se el ítem al Listbox2, borrándose el dato en el Listbox1.

Si se requiere ya sea por error o por lo que sea revertir la acción, presionando un ítem en el Listbox2 se pasa el registro al Listbox1, borrándose el dato en el Listbox2.

En primer lugar se debe detectar, en el evento KeyPress, cuando se presiona Enter en el Listbox1 tenga el foco, eso se hacer apelando a la tabla de código Ascii, donde 13 representa la tecla Enter, previo se crea un objeto con el Listbox1 (a) y Listox2 (b), se usa el siguiente código:

Set a = UserForm1.ListBox1
Set b = UserForm1.ListBox2
If KeyAscii = 13 Then

Se carga en la variable fila, el número de la fila seleccionada, esto nos sirve para saber que datos se deben pasar al otro listbox y a la vez que item eliminar del Listbox1, pasando los datos de un listbox a otro, con los siguientes códigos:

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)

La fila a eliminar del Listbox1 se realiza con el siguiente código:

a.RemoveItem a.ListIndex

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

Como abrir otro libro y copiar o exportar datos del libro actual


Como llenar listbox con additem o RowSource para más de diez columnas

Como enviar Mail dependiendo de fecha

Bien ya se han pasado los datos del Listbox1 al Listbox2 y se ha eliminado la fila donde estába el item seleccionado, suponiendo el caso que se quiera volver al Listbox1 los datos pasados sea el último dato pasado o cualquiera que hayamos pasado antes, se apela a un código parecido pero se debe colocar en el evento Keypress del Listbox2, realizando los mismos pasos narrados para el Listbox1.

Es decir se crean los objetos con los Listbox1 y Listbox2, se detecta cuando se presiona Enter en Listbox2, se carga en variable fila cual es el número de fila del ítem seleccionado en el Listbox2, así:

Set aa = UserForm1.ListBox1
Set bb = UserForm1.ListBox2
If KeyAscii = 13 Then
fila = bb.ListIndex

Queda pasar los datos al Listbox1 y eliminar en el Listbox2 (fondo celeste del ejemplo) la fila que se paso al Listbox1, se hace con el siguiente código:

aa.AddItem bb.List(fila, 0)
aa.List(aa.ListCount - 1, 1) = bb.List(fila, 1)
aa.List(aa.ListCount - 1, 2) = bb.List(fila, 2)
aa.List(aa.ListCount - 1, 3) = bb.List(fila, 3)
bb.RemoveItem bb.ListIndex

Puedes descargar el ejemplo Como Copiar y Eliminar Ítem al Pasar de Listbox a Otro Listbox y Viceversa con Enter desde el el final del post, seguidamente el código completo que contiene el formulario.


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)
a.RemoveItem a.ListIndex
End If
End Sub

Private Sub ListBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
Set aa = UserForm1.ListBox1
Set bb = UserForm1.ListBox2
If KeyAscii = 13 Then
fila = bb.ListIndex
aa.AddItem bb.List(fila, 0)
aa.List(aa.ListCount - 1, 1) = bb.List(fila, 1)
aa.List(aa.ListCount - 1, 2) = bb.List(fila, 2)
aa.List(aa.ListCount - 1, 3) = bb.List(fila, 3)
bb.RemoveItem bb.ListIndex
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
   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
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
   Exit Sub
End If
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
Me.ListBox1.ColumnWidths = "20 pt;90pt;80 pt;80 pt"
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 = 4
    .ColumnWidths = "20 pt;90pt;80 pt;80 pt"
    '.RowSource = "Hoja2!A2:" & wc & uf
End With
With Me.ListBox2
    .ColumnCount = 4
    .ColumnWidths = "25 pt;90pt;60 pt;60 pt"
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)

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