.
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.
if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}
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:
La fila a eliminar del Listbox1 se realiza con el siguiente código:
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
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í:
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:
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://macrosenexcel.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
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
‘**************https://macrosenexcel.com **** https://youtube.com/programarexcel*********
Sub muestra1()
UserForm1.Show
End Sub
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
.
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