No limpiar check de listbox al filtrar
Para Dan
Hola sabes que tengo un inconveniete con el codigo que no he podido arreglar..
Tengo un listbox
Un textbox "Textbox5" que es para ir escribiendo y filtrar el listbox y tengo un textbox "Textbox1" que al seleccionar un check del listbox los nombres se copian al textbox "Textbox1"...
Problema..
Ejemplo
Al iniciar el userform se cargan los datos selecciono un check y este se copia al textbox1 .. Pero si quiero buscar en el textbox5 este filtra el listbox y selecciono un check "y es aqui el problema que el check anterior se borra dado que filtre y el codigo de filtro limpia antes de buscar" entonces al seleccionar un check es como si fuese el primero que selecciono y no deberia ser asi si antes he seleccionado uno...
¿Por favor me echas una mano con esto?
No se si me explique bien
Adjunto el codigo " la parte de ir selecionando los check y copair al textbox1 eso lo hicistes tu la otra vez""
Private Sub CommandButton1_Click()
Application.Visible = True
End Sub
Private Sub Lista_Change()
tnum = 1 'Número de textbox
wmax = 7 'límite por textbox
n = 0
t = 1
'
For i = 1 To tnum
Me.Controls("TextBox" & i) = ""
Next
For i = 0 To Lista.ListCount - 1 'Step -1
If Lista.Selected(i) Then
If n = wmax Then
n = 0
t = t + 1
If t > tnum Then
MsgBox "Se alcanzó el número máximo de textbox", vbExclamation
Exit Sub
End If
End If
If Me.Controls("TextBox" & t) = "" Then
Me.Controls("TextBox" & t) = Lista.List(i, 2)
Else
Me.Controls("TextBox" & t) = Me.Controls("TextBox" & t) & " ; " & Lista.List(i, 2)
End If
n = n + 1
End If
Next
End Sub
Private Sub TextBox5_Change()
Me.Lista.Clear
If Trim(TextBox5.Value) = "" Then
Lista.List() = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
Exit Sub
End If
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
cadena = UCase(Cells(i, 1).Value) & UCase(Cells(i, 2).Value) & UCase(Cells(i, 3).Value)
If cadena Like "*" & UCase(TextBox5.Value) & "*" Then
Lista.AddItem Cells(i, 1)
Lista.List(Lista.ListCount - 1, 1) = Cells(i, 2)
Lista.List(Lista.ListCount - 1, 2) = Cells(i, 3)
End If
Next i
Exit Sub
Errores:
MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO"
End Sub
Private Sub UserForm_Initialize()
Lista.Clear
With Lista
.ColumnCount = 3
.ColumnWidths = "60 pt;160 pt; 70 pt"
End With
Lista.List() = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub
1 Respuesta
Dan
Gracias por responder ya le envíe mi archivo...
Muchas gracias
Para controlar los check que has marcado y desmarcado, con filtro o sin filtro, es necesario llevar un registro en alguna parte; y para llevar ese registro de lo que has seleccionado, se me ocurre que se puede llevar en la misma hoja en las columnas E y F, por lo tanto, la carga del listbox deberá contemplar las columnas E y F.
Te anexo el código completo:
Private Sub Lista_Change()
'Por.Dante Amor
tnum = 1 'Número de textbox
wmax = 7 'límite por textbox
n = 0
t = 1
fila = Lista.List(Lista.ListIndex, 4)
'
For i = 1 To tnum
Me.Controls("TextBox" & i) = ""
Next
'
Cells(fila, "F") = Lista.Selected(Lista.ListIndex)
'
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(i, "F") = True Then
If n = wmax Then
MsgBox "Se alcanzó el máximo"
Lista.Selected(Lista.ListIndex) = False
Cells(fila, "F") = Lista.Selected(Lista.ListIndex)
Exit Sub
End If
'
If Me.Controls("TextBox" & t) = "" Then
Me.Controls("TextBox" & t) = Cells(i, "C")
Else
Me.Controls("TextBox" & t) = Me.Controls("TextBox" & t) & " ; " & Cells(i, "C")
End If
n = n + 1
End If
Next
End Sub
'
Private Sub TextBox5_Change()
'Por.Dante Amor
Me.Lista.Clear
If Trim(TextBox5.Value) = "" Then
Lista.List() = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
Else
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
cadena = UCase(Cells(i, 1).Value) & UCase(Cells(i, 2).Value) & UCase(Cells(i, 3).Value)
If cadena Like "*" & UCase(TextBox5.Value) & "*" Then
Lista.AddItem Cells(i, "A")
Lista.List(Lista.ListCount - 1, 1) = Cells(i, "B")
Lista.List(Lista.ListCount - 1, 2) = Cells(i, "C")
Lista.List(Lista.ListCount - 1, 3) = Cells(i, "D")
Lista.List(Lista.ListCount - 1, 4) = Cells(i, "E")
End If
Next i
End If
'
For i = 0 To Lista.ListCount - 1
fila = Lista.List(i, 4)
Lista.Selected(i) = Cells(fila, "F")
Next
Exit Sub
Errores:
MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO"
End Sub
'
Private Sub UserForm_Initialize()
'Por.Dante Amor
With Lista
.ColumnCount = 5
.ColumnWidths = "60 pt;160 pt; 70 pt;0;0"
End With
Columns("E:F").ClearContents
u = Range("A" & Rows.Count).End(xlUp).Row
[E1] = 1
[E2] = 2
If u > 2 Then
Range("E1:E2").AutoFill Destination:=Range("E1:E" & u), Type:=xlFillDefault
End If
Lista.List() = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub
'
Private Sub CommandButton1_Click()
Application.Visible = True
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
Gracias Dan
Pero como son muchos los check !
A la hora de filtrar puede ser el ultimo nombre más algunos nombres del medio los selecciono y al querer seleccionar más tengo que desmarcarlos "para eso tengo que buscarlos y desmarcarlos" le puse un commandbutton para eliminar las selecciones y eliminar lo del textbox1 y lo de la hoja1 del rango E y F funciona pero si escribo un nombre para filtrar se cae el programa... esto le agregue al commandbutton2
Private Sub CommandButton2_Click() Hoja1.Range("E2:F255")=""r=7for i =0 to r lista.Selected(i)= falsenexttextbox1.text=""End SubPor favor Gracias
No modifiques la macro!
Así como te lo envíe, puedes marcar y desmarcar, la macro siempre te va amostrar los ya marcados, así filtres, desfiltres, vuelvas a filtrar, marques o desmarques; la macro ya considera todo eso y siempre cuenta hasta el valor máximo.
Si quieres seleccionar más registros, obviamente tienes que desmarcar registros para poder seleccionar otro.
Si quieres que revise tu macro "para eliminar las selecciones", valora esta respuesta y crea una nueva.
