Agregar una columna más en macro para filtrado
En el libro Lista Repuestos que tendrás por ahí, en el evento
Sub FiltrarLista2(col1, col2, col3)
y de los OptionButton y
Private Sub cbtFiltro_Click() 'LISTO
'Por.Dante Amor
If OptionButton1 Then
Call FiltrarLista2("B", "K", "D")
ElseIf OptionButton2 Then
Call FiltrarLista2("M", "V", "O")
End If
' MsgBox "No se encuentra.", vbExclamation, "Inexistente"
End SubMarco OptionButton “Filtrar página 1” y me filtra de la página 1 toda columna D sin escribir algo en el TextBox, así lo quiero, está fenómeno
Lo mismo sucede con el OptionButton “Filtrar página 2” en la columna O
Marcado el OptionButton “Filtrar página 2” y escribo Ej.: “sea” (sin comillas) piso el botón Filtrar me muestra resultados SEAL, SEALL etc, de la columna O, fenomenal.
Lo mismo sucede si está marcado el OptionButton “Filtrar página 1” me filtra en la página 1 columna C
Lo anterior está perfecto, ¿qué quiero? Agregar al filtrado una columna más al filtrado, la C de la pagina1 y la N de la página 2
Quedando el filtrando en las columnas C y DE de la página 1 y N y O de la página 2
¿Se podrá amigo Dante?
1 Respuesta
h o l a:
quedaría así:
Private Sub OptionButton1_Click()
Call FiltrarLista2("B", "K", "C", "D")
End Sub
Private Sub OptionButton2_Click()
Call FiltrarLista2("M", "V", "N", "O")
End Sub
Sub FiltrarLista2(col1, col2, col3, col4)
'Por.Dante Amor
Set h1 = Sheets("Lista Repuestos")
Set h2 = Sheets("filtro")
h2.Cells.ClearContents
Lista2.RowSource = ""
fila = 46
h1.Range("B10:K10").Copy h2.Range("A1")
j = 2
For i = 11 To 46
If Cells(i, col1) <> "" And _
UCase(h1.Cells(i, col3) & h1.Cells(i, col4)) Like "*" & UCase(txtFiltro) & "*" Then
h1.Range(col1 & i & ":" & col2 & i).Copy h2.Cells(j, "A")
h2.Cells(j, "K") = i
j = j + 1
End If
Next
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
If u2 > 1 Then
Lista2.RowSource = h2.Name & "!A2:K" & u2
Else
MsgBox "No se encuentra.", vbExclamation, "Inexistente"
End If
End Subsal u dos
Hola Dante
Usando el evento Private Sub cbtElimi_Click() para eliminar alguna linea, me manda este error en el evento, 1ª
Le agregue lo de rojo y sin embargo al volver a eliminar alguna línea elimina pero me dice esto
y me apunta a
del evento Sub FiltrarLista2(col1, col2, col3, col4)
¿Cómo se puede arreglar esto?
Gracias por tu tiempo amigo
Filtrar si filtra bien como solicite, el detalle cuando quiero eliminar alguna línea
Te envié el archivo con todas las macros
Hola Dante
Precisamente en el que me enviaste es donde hice lo comentado y las muestras de detalles, son desde ese mismo libro
Regresame el archivo y me explicas lo que te hace falta, ya sabes con ejemplos
Repito y me disculpas.
Cuanto a filtrar en 2 columnas si lo hace bien pero afectó la macro para Eliminar una ves que esa macro contienen un Call llamando la macro Call FiltrarLista2(c1, c2, c3) a la cual le agregue c4 quedando Call FiltrarLista2(c1, c2, c3, c4)
.
Vuelvo a frmEliminar filtro marcando uno de los OptionButton selecciono una línea y piso el button Eliminar y es cuando me dice lo de la ultima imagen apuntando hacia y me manda a la
Listo:
Private Sub cbtElimi_Click()
'Por.Dante Amor http://www.todoexpertos.com/preguntas/6tq7iumqenw3rrpx/eliminar-los-registros-seleccionados-en-el-listbox
'Eliminar el registro
ActiveSheet.Unprotect Password:="By Jot@"
If Lista2.ListIndex = -1 Then
MsgBox "No hay registros"
Exit Sub
End If
seleccionado = False
For i = 0 To Lista2.ListCount - 1
If Lista2.Selected(i) Then
seleccionado = True
Exit For
End If
Next
If seleccionado = False Then
MsgBox "Selecciona un registro"
Exit Sub
End If
Pregunta = MsgBox("Está seguro para eliminar el registro?", vbYesNo + vbQuestion, "Eliminación")
If Pregunta = vbNo Then Exit Sub
'
If OptionButton1 Then
c1 = "B": c2 = "K": c3 = "C": c4 = "D"
ElseIf OptionButton2 Then
c1 = "M": c2 = "V": c3 = "N": c4 = "O"
End If
'
Application.ScreenUpdating = False
For i = Lista2.ListCount - 1 To 0 Step -1
If Lista2.Selected(i) Then
fila = Lista2.List(i, 10)
If fila < 46 Then
Range(c1 & fila + 1 & ":" & c2 & 46).Copy Range(c1 & fila)
End If
Range(c1 & 46 & ":" & c2 & 46).ClearContents
End If
Next
For i = 11 To 46
Range("D" & i & ":I" & i).Merge
Range("O" & i & ":T" & i).Merge
Next
Call FiltrarLista2(c1, c2, c3, c4)
ActiveSheet.Protect Password:="By Jot@"
Application.ScreenUpdating = True
End Subsal u dos
