Borrar varios registros desde un listbox VBA Excel
Ante todo agradecer por el tiempo que se toman en ayudarnos con nuestras dudas bueno el problema que tengo es el siguiente tengo una hoja llamada Datos donde guardo información desde la celda A2 hasta la celda BT6500 en esa hoja tengo varios registros duplicados por el numero de documento de identidad que se encuentra en la columna B lo que deseo es que esos números duplicados se carguen a un listbox que se encuentra en un Userform1 para luego poder seleccionar varios de ellos y poder eliminarlos al mismo tiempo.
1 Respuesta
¿Un número puede aparecer 1 o 2 veces? O puede aparecer 1, ¿2 o más veces?
Si aparece solamente 1 o 2 veces, y un número aparece 2 veces, ¿quieres qué en el listbox te aparezcan los 2 registros o solamente 1 de los 2?
El mismo caso para cuando un número aparece, digamos 4 veces, ¿quieres qué te aparezcan los 4 registros o solamente 1?
Si quieres que aparezcan todos, es decir, si hay 4 repetidos te aparezcan los 4 registros en el listbox, prueba con lo siguiente.
Pon todo el siguiente código en tu userform.
Crea 2 botones en tu useerform, uno para cargar los datos en el listbox y otro para eliminar filas.
Cambia en la macro "Hoja2" por el nombre de tu hoja que contiene los datos.
Crea una hoja y le pones el nombre "temp"
Dim h1, h2
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
'
'Botón para cargar el list
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
h2.Cells.ClearContents
h1.Rows(1).Copy h2.Rows(1)
uf = h1.Range("B" & Rows.Count).End(xlUp).Row
uc = h1.Columns("BT").Column
'
j = 2
uc = uc + 1
For i = 2 To uf
num = h1.Cells(i, "B")
cuenta = WorksheetFunction.CountIf(h1.Range("B2:B" & uf), num)
If cuenta > 1 Then
h1.Rows(i).Copy h2.Rows(j)
h2.Cells(j, uc) = i
j = j + 1
End If
Next
'
letra = Evaluate("=SUBSTITUTE(ADDRESS(1," & uc & ",4),""1"","""")")
h2.Columns("A:" & letra).EntireColumn.AutoFit
For j = 1 To uc
cad = cad & Int(h2.Cells(1, j).Width) + 2 & "; "
Next
With ListBox1
.ColumnCount = uc
.ColumnWidths = cad
.RowSource = h2.Name & "!A2:" & letra & uf
End With
End Sub
'
Private Sub CommandButton2_Click()
'Por.Dante Amor
'
'Botón para eliminar
'
Dim filas As New Collection
'
If ListBox1.ListIndex = -1 Then
MsgBox "Selecciona registros del listbox"
Exit Sub
End If
If ListBox1.ListIndex = 0 Then
If ListBox1.Selected(0) = False Then
MsgBox "Selecciona registros del listbox"
Exit Sub
End If
End If
'
col = ListBox1.ColumnCount
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
fila = Val(ListBox1.List(i, col - 1))
agregado = False
For j = 1 To filas.Count
If filas(j) > fila Then
filas.Add fila, before:=j
agregado = True
Exit For
End If
Next
If agregado = False Then
filas.Add fila
End If
End If
Next
Application.ScreenUpdating = False
For n = filas.Count To 1 Step -1
fila = filas(n)
h1.Rows(fila).Delete
Next
Call CommandButton1_Click
MsgBox "Registros eliminados"
Application.ScreenUpdating = True
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
Set h1 = Sheets("Hoja2")
Set h2 = Sheets("temp")
With ListBox1
.ColumnHeads = True
.MultiSelect = 1
End With
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Muchas ¡Gracias! La respuesta estuvo perfecta por eso valoración excelente que tenga buen día y un favor más si no es mucha molestia hice dos preguntas dirigidas a usted si dispone de tiempo espero pueda ayudarme pero de antemano ya muchas gracias por todo
