¿Porque listbox con filtro me carga duplicados?
Estoy liado con un procedimiento, les explico.
Tengo un listbox que me realiza un filtro (autoría de luis mondelo), cuando filtra carga los datos de un rango, pero me esta cargando varias veces los registros cuando en el rango ni siquiera se repiten. No se como resolver esto, piso un poco de su ayuda para poder resolverlo, muchas gracias.
Dejo todo el código de form.
Dim uf As Long
Private Sub CommandButton1_Click()
ActiveCell.Offset(0, 1).Value = TextBox3
ActiveCell.Offset(0, 2).Value = TextBox4
ActiveCell.Offset(0, 3).Value = TextBox5
ActiveCell.Offset(0, 4).Value = TextBox6
ActiveCell.Offset(0, 5).Value = TextBox7
ActiveCell.Offset(0, 6).Value = TextBox8
ActiveCell.Offset(0, 7).Value = TextBox9
ActiveCell.Offset(0, 8).Value = TextBox10
MsgBox "Modificación Exitosa!", vbInformation, "Información"
End Sub
Private Sub ListBox1_Click()
On Error Resume Next
uf = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Range("a11").Activate
Cuenta = Me.ListBox1.ListCount
For i = 0 To Cuenta - 1
If Me.ListBox1.Selected(i) Then
Valor = Me.ListBox1.List(i)
Sheets("Personal").Range("A11:A" & uf).Find(What:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate
End If
Next i
TextBox2 = ActiveCell.Offset(0, 0).Value
TextBox3 = ActiveCell.Offset(0, 1).Value
TextBox4 = ActiveCell.Offset(0, 2).Value
TextBox5 = ActiveCell.Offset(0, 3).Value
TextBox6 = ActiveCell.Offset(0, 4).Value
TextBox7 = ActiveCell.Offset(0, 5).Value
TextBox8 = ActiveCell.Offset(0, 6).Value
TextBox9 = ActiveCell.Offset(0, 7).Value
TextBox10 = ActiveCell.Offset(0, 8).Value
End Sub
Private Sub TextBox1_Change()
uf = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
ListBox1.Clear
Valor = TextBox1.Value
Set busca = Sheets("personal").Range("a10:e" & uf).Find(Valor, LookIn:=xlValues, LookAt:=xlPart)
If Not busca Is Nothing Then
ubica = busca.Address
Do
ubica2 = "$A$" & busca.Row
ListBox1.AddItem Range(ubica2)
i = ListBox1.ListCount - 1
ListBox1.List(i, 1) = Range(ubica2).Offset(0, 1)
ListBox1.List(i, 2) = Range(ubica2).Offset(0, 2)
ListBox1.List(i, 3) = Range(ubica2).Offset(0, 3)
ListBox1.List(i, 4) = Range(ubica2).Offset(0, 4)
ActiveCell.Select
Set busca = Sheets("personal").Range("a1:e" & uf).FindNext(busca)
Loop While Not busca Is Nothing And busca.Address <> ubica
End If
End Sub
Sub carga()
Dim uf As Long
uf = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
With ListBox1
.ColumnCount = 5
.ColumnWidths = "60 pt;60 pt;70 pt"
.ColumnHeads = True
End With
ListBox1.RowSource = "Personal!" & "A11:E" & uf
End Sub
1 Respuesta
Respuesta de Dante Amor
1
H o l a :
Te anexo la macro actualizada
Private Sub CommandButton1_Click()
'Por.Dante Amor
If ListBox1.ListIndex = -1 Then Exit Sub
f = ListBox1.List(ListBox1.ListIndex, 5)
Cells(f, "B") = TextBox3
Cells(f, "C") = TextBox4
Cells(f, "D") = TextBox5
Cells(f, "E") = TextBox6
Cells(f, "F") = TextBox7
Cells(f, "G") = TextBox8
Cells(f, "H") = TextBox9
Cells(f, "I") = TextBox10
MsgBox "Modificación Exitosa!", vbInformation, "Información"
End Sub
'
Private Sub ListBox1_Click()
'Por.Dante Amor
If ListBox1.ListIndex = -1 Then Exit Sub
f = ListBox1.List(ListBox1.ListIndex, 5)
TextBox2 = Cells(f, "A")
TextBox3 = Cells(f, "B")
TextBox4 = Cells(f, "C")
TextBox5 = Cells(f, "D")
TextBox6 = Cells(f, "E")
TextBox7 = Cells(f, "F")
TextBox8 = Cells(f, "G")
TextBox9 = Cells(f, "H")
TextBox10 = Cells(f, "I")
End Sub
'
Private Sub TextBox1_Change()
'Por.Dante Amor
ListBox1.Clear
If TextBox1 = "" Then Exit Sub
Set h = Sheets("personal")
Set r = h.Range("A10:A" & h.Range("A" & Rows.Count).End(xlUp).Row)
Set b = r.Find(TextBox1, LookIn:=xlValues, LookAt:=xlPart)
If Not b Is Nothing Then
celda = b.Address
fila = 0
Do
If b.Row <> fila Then
fila = b.Row
ListBox1.AddItem h.Cells(b.Row, "A")
ListBox1. List(ListBox1.ListCount - 1, 1) = h. Cells(b.Row, "B")
ListBox1. List(ListBox1.ListCount - 1, 2) = h. Cells(b.Row, "C")
ListBox1. List(ListBox1.ListCount - 1, 3) = h. Cells(b.Row, "D")
ListBox1. List(ListBox1.ListCount - 1, 4) = h. Cells(b.Row, "E")
ListBox1.List(ListBox1.ListCount - 1, 5) = b.Row
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
End SubTambién tienes esta macro pero no veo en dónde la utilizas, entonces si no la utilizas la puedes borrar.
Sub carga()
Dim uf As Long
uf = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
With ListBox1
.ColumnCount = 5
.ColumnWidths = "60 pt;60 pt;70 pt"
.ColumnHeads = True
End With
ListBox1.RowSource = "Personal!" & "A11:E" & uf
End SubAvísame cualquier detalle de las macros para realizar los ajustes.
' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
