Filtrar y cargar registros repetidos por varias columnas
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 diferentes columnas por la columna B donde tengo informacion del DNI de la persona la columna D donde tengo informacion del tipo de reporte y la columna E donde tengo informacion del establecimiento en estas tres columnas se suele repetir tanto el DNI como el tipo de reporte y el establecimiento lo que deseo es poder filtrar por cualquiera de estas 3 columnas y esos datos repetidos mostrarlos luego en un listbox aca abajo les pongo una imagen
Esta es la imagen del formulario donde en la parte superior tengo los 3 filtros y quisiera que al momento de escoger 1 o 2 filtros o los 3 filtros al mismo tiempo y presionar filtrar me muestre esos datos repetidos en el listbox de abajo ante todo agradecer por el tiempo que se toman en atender nuestras preguntas espero puedan ayudarme
1 respuesta
Envíame tu archivo con tu userform. Dime cómo se llama tu formulario.
Explícame 3 ejemplos, es decir, qué datos pondrías en cada campo y qué resultado esperas en el listbox, el resultado que esperas en el listbox lo pones en una hoja nueva.
Pon en una hoja nueva cada uno de los ejemplos, entonces me vas a enviar 4 hojas, una hoja con la base de datos y tres hojas con los ejemplos.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Yima Ara” y el título de esta pregunta.
Te anexo la macro
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
h1.Columns("BV:BZ").ClearContents
h1.Columns("BV:BZ").NumberFormat = "General"
'
j = 2
uc = uc + 1
If CheckBox1 Then
With h1.Range(h1.Cells(2, uc + 1), h1.Cells(uf, uc + 1))
.Formula = "=RC2"
.Value = .Value
End With
End If
If CheckBox2 Then
With h1.Range(h1.Cells(2, uc + 2), h1.Cells(uf, uc + 2))
.Formula = "=RC4"
.Value = .Value
End With
End If
If CheckBox3 Then
With h1.Range(h1.Cells(2, uc + 3), h1.Cells(uf, uc + 3))
.Formula = "=RC5"
.Value = .Value
End With
End If
If ComboBox1 <> "" Then
With h1.Range(h1.Cells(2, uc + 4), h1.Cells(uf, uc + 4))
.Formula = "=IF(RC[-70]=" & ComboBox1.Value & ",RC[-70],"""")"
.Value = .Value
End With
Else
With h1.Range(h1.Cells(2, uc + 4), h1.Cells(uf, uc + 4))
.Formula = "="""""
.Value = .Value
End With
End If
With h1.Range(h1.Cells(2, uc + 5), h1.Cells(uf, uc + 5))
.FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-2]&RC[-1]"
.Value = .Value
End With
'
For i = 2 To uf
num = h1.Cells(i, uc + 5)
cuenta = WorksheetFunction.CountIfs(h1.Range(h1.Cells(2, uc + 5), h1.Cells(uf, uc + 5)), num)
If cuenta > 1 Then
If h1.Cells(i, uc + 4) = Val(ComboBox1) Then
h1.Rows(i).Copy h2.Rows(j)
h2.Cells(j, uc) = i
j = j + 1
End If
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) + 4 & "; "
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 cua
Hola Dante buenos días tendrás el archivo para solicitar ? saludos! - Adriel Ortiz Mangia