Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL
Listbox de Excel

Como Eliminar Item al Pasar Datos Listbox a Otro y Guardar


.

En este post se muestra algo solicitado en nuestro canal de YouTube, es una Macro que Pasa Datos de un Listbox a Otro y Guarda en Hoja Excel, es otras palabras se muestra como haciendo doble click se pasa un elemento del listbox a otro listbox, a su vez guarda en la hoja correspondiente eliminando el item de la base de datos que da origen al 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.

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.


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);
}
}

 
Para que sea más fácil de entender recomiendo descargar el ejemplo, desde el link del final se podrá hacer dicha descarga, el ejemplo muestra como al hacer doble click en en el Listbox1 que es el que tiene fondo blanco, se pasa el item al Listbox2 que tiene fondo celeste.

A la vez que se pasan los datos de un Listbox a Otro Listbox, también se borra de la Hoja1 de Excel que sirve de base de datos para el Listbox1, guardando el dato en la Hoja2 que es la base de datos del Listbox1.

Básicamente la programación del Listbox2 es idéntica a la del Listbox1, solo que Intercambia donde debe copiar y eliminar datos tanto del listbox como de la hoja de Excel que es donde están contenidos los datos que se muestran en el mismo, es por ello que solo se explicará sobre que realiza la macro en el Listbox1 quedando como tarea para los lectores replicar la misma macro, pero en el Listbox2, no obstante el código que se expone está en forma completa para los dos Listbox.

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

Quizá sea de utilidad también

Como Exportar desde Excel a TXT de Ancho Fijo

Como Espaciar los Registros en Listbox de Excel

Como Buscar por Cliente Rango de Fechas y Totalizar en el Listbox

Para lograr realizar lo mencionado en el ejemplo se debe primero pasar los datos del Listbox1 al Listbox2, lo cual se logra con los siguientes códigos:

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)

También se debe guardar el dato correspondiente en la Hoja2 para ello se usan estos códigos

filaedit = c.Range(«A» & Rows.Count).End(xlUp).Row + 1
c.Cells(filaedit, «A») = a.List(fila, 0)
c.Cells(filaedit, «B») = a.List(fila, 1)
c.Cells(filaedit, «C») = a.List(fila, 2)
c.Cells(filaedit, «D») = a.List(fila, 3)

Luego se ordenan los datos en la Hoja2 así:

uf = c.Range(«A» & Rows.Count).End(xlUp).Row
r1 = «A1:D» & uf
r2 = «A1:A» & uf
c.Sort.SortFields.Clear
c.Sort.SortFields.Add Key:=Range(r2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With c.Sort
.SetRange Range(r1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Luego se busca en la Hoja1 el item correspondiente para eliminarlo, ya que fue guardado en la Hoja2, se usan los siguienes códigos:

uf = d.Range(«A» & Rows.Count).End(xlUp).Row
r1 = «A2:A» & uf
busco = a.List(fila, 0)
Set codigo = Range(r1).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then d.Cells(codigo.Row, «A»).EntireRow.Delete
a.RemoveItem a.ListIndex
End Sub

Se debe tener presente que se tiene que eliminar el item del Listbox1, para ello se usa el siguiente código:

a.RemoveItem a.ListIndex

En resumen, la macro copia del Listbox1 al Listbox2, copia inmediatamente los registos en la Hoja2, a la vez que busca el mismo dato en la Hoja 1 para elimiarlo, por último elimina el item en el Listbo1; el código completo del Ejemplo de macro llamado Como Eliminar Item al Pasar Datos Listox a Otro Listbox y Guardar Datos en Excel se muestra a continuación y seguidamente se encuentra el link para descarga del ejemplo.

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_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Set a = UserForm1.ListBox1
Set b = UserForm1.ListBox2
Set c = Sheets(«Hoja2»)
Set d = Sheets(«Hoja1»)
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)

filaedit = c.Range(«A» & Rows.Count).End(xlUp).Row + 1
c.Cells(filaedit, «A») = a.List(fila, 0)
c.Cells(filaedit, «B») = a.List(fila, 1)
c.Cells(filaedit, «C») = a.List(fila, 2)
c.Cells(filaedit, «D») = a.List(fila, 3)

uf = c.Range(«A» & Rows.Count).End(xlUp).Row
r1 = «A1:D» & uf
r2 = «A1:A» & uf
c.Sort.SortFields.Clear
c.Sort.SortFields.Add Key:=Range(r2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With c.Sort
.SetRange Range(r1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

uf = d.Range(«A» & Rows.Count).End(xlUp).Row
r1 = «A2:A» & uf
busco = a.List(fila, 0)
Set codigo = Range(r1).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then d.Cells(codigo.Row, «A»).EntireRow.Delete
a.RemoveItem a.ListIndex
End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Set aa = UserForm1.ListBox1
Set bb = UserForm1.ListBox2
Set cc = Sheets(«Hoja2»)
Set dd = Sheets(«Hoja1»)

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)

filaedit = dd.Range(«A» & Rows.Count).End(xlUp).Row + 1
dd.Cells(filaedit, «A») = bb.List(fila, 0)
dd.Cells(filaedit, «B») = bb.List(fila, 1)
dd.Cells(filaedit, «C») = bb.List(fila, 2)
dd.Cells(filaedit, «D») = bb.List(fila, 3)

uf = dd.Range(«A» & Rows.Count).End(xlUp).Row
r1 = «A1:D» & uf
r2 = «A1:A» & uf
dd.Sort.SortFields.Clear
dd.Sort.SortFields.Add Key:=Range(r2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With dd.Sort
.SetRange Range(r1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

uf = cc.Range(«A» & Rows.Count).End(xlUp).Row
r1 = «A2:A» & uf
busco = bb.List(fila, 0)
Set codigo = cc.Range(r1).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then cc.Cells(codigo.Row, «A»).EntireRow.Delete
bb.RemoveItem bb.ListIndex
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 a = Sheets(«Hoja1»)
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

uf = a.Range(«A» & Rows.Count).End(xlUp).Row
For i = 2 To uf
       Me.ListBox1.AddItem a.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = a.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = a.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = a.Cells(i, 4)
Next i

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.ListBox2.AddItem b.Cells(i, 1)
       Me.ListBox2.List(Me.ListBox2.ListCount – 1, 1) = b.Cells(i, 2)
       Me.ListBox2.List(Me.ListBox2.ListCount – 1, 2) = b.Cells(i, 3)
       Me.ListBox2.List(Me.ListBox2.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://macrosenexcel.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