每次搜索/用户表单后自动筛选所有列 VBA
AutoFilter all columns after every Search / Userform VBA
我有一个工作簿，每次打开它时，都会从它所拥有的任何过滤器中清除该工作簿，它可以正常工作。但是我想这样实现，每次完成搜索时，都会清除应用于该工作簿的过滤器。它给了我一个我无法解决的错误。
我也尝试过 If Sheets("Datos").AutoFilterMode then Sheets("Datos").AutoFilterMode = False 但又出现了另一个错误。
此外，每次激活第二个 if 时，应填充按姓氏过滤的总行数的文本框不会显示任何内容，但在应用第一个 if 时会显示任何内容，即用户 ID。 （如果需要问其他话题，就省略这一段）
Private Sub btnBuscar4_Click()
'declarar las variables
Dim FindRow
Dim LastRow As Integer, i As Integer
Dim cRow As String
Dim Datos As Worksheet: Set Datos = Workbooks.Open("C:\Users\Bonito\Desktop\Plataforma\Datos.xlsm").Worksheets("Datos")
'Aplica la liberación de las hojas para consultarlas
SheetProtection
'Si hay filtros, los elimina de la hoja Datos
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
'Windows("Datos.xlsm").Visible = False 'Hace que no se muestre el excel externo (Datos)
'hold in memory and stop screen flicker
'Application.ScreenUpdating = False
'error block
On Error GoTo errHandler:
'Filtrar solo por Legajo
If Me.BLeg3 <> "" Then
'Guardar el legajo en una variable
cRow = Me.BLeg3.Value
Worksheets("Datos").Range("A:A").AutoFilter Field:=1, Criteria1:=cRow
LastRow = Sheets("Datos").Range("A500").End(xlUp).Row - 1 'Hay que restarle uno para sacar el titulo
For i = 2 To LastRow
If Cells(i, 1) = cRow Then
Reg2.Value = LastRow 'Muestra la cantidad de filas filtradas de ese legajo
End If
Next i
'Encontrar la fila con la data
Set FindRow = Datos.Range("A:A").Find(What:=cRow, LookIn:=xlValues)
Me.CurrentAddress = FindRow.Address 'te trae la celda actual
'agregar los valores a las casillas correspondientes
Leg3.Value = FindRow
Fech3.Value = FindRow.Offset(0, 4)
Ape3.Value = FindRow.Offset(0, 1)
Nomb3.Value = FindRow.Offset(0, 2)
Pues3.Value = FindRow.Offset(0, 3)
ComboLiqui3.Value = FindRow.Offset(0, 5)
FechaDesde3.Value = FindRow.Offset(0, 6)
FechaHasta3.Value = FindRow.Offset(0, 7)
Dia3.Value = FindRow.Offset(0, 12)
Dia4.Value = FindRow.Offset(0, 13)
Cant3.Value = FindRow.Offset(0, 8)
Obs3.Value = FindRow.Offset(0, 9)
'Filtrar solo por Apellido
ElseIf Me.BApe3 <> "" Then
'Encontrar la fila con la data
cRow = Me.BApe3.Value
Worksheets("Datos").Range("B:B").AutoFilter Field:=1, Criteria1:=cRow
LastRow = Sheets("Datos").Range("B500").End(xlUp).Row - 1 'Hay que restarle uno para sacar el titulo / Se va hasta la ultima row y automaticamente sube al comienzo
For i = 2 To LastRow
If Cells(i, 1) = cRow Then
Reg2.Value = LastRow 'Muestra la cantidad de filas filtradas de ese legajo
End If
Next i
Set FindRow = Datos.Range("B:B").Find(What:=cRow, LookIn:=xlValues)
Me.CurrentAddress = FindRow.Address 'te trae la celda actual
'agregar los valores a las casillas correspondientes
Leg3.Value = FindRow.Offset(0, -1)
Fech3.Value = FindRow.Offset(0, 3)
Ape3.Value = FindRow
Nomb3.Value = FindRow.Offset(0, 1)
Pues3.Value = FindRow.Offset(0, 2)
ComboLiqui3.Value = FindRow.Offset(0, 4)
FechaDesde3.Value = FindRow.Offset(0, 5)
FechaHasta3.Value = FindRow.Offset(0, 6)
Dia3.Value = FindRow.Offset(0, 11)
Dia4.Value = FindRow.Offset(0, 12)
Cant3.Value = FindRow.Offset(0, 7)
Obs3.Value = FindRow.Offset(0, 8)
Else
MsgBox "Por favor, ingresar un Legajo o un Apellido"
End If
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "Error! Verificar los datos ingresados, porque no son correctos!" & vbCrLf & Err.Description
End Sub
您无法使用 End(xlUp).Row 计算筛选的行数。您需要使用 SpecialCells(xlCellTypeVisible).Cells.Count。我不明白过滤器的问题，因为它对我有用。尝试
Private Sub btnBuscar4_Click()
Const DATA = "C:\Users\Bonito\Desktop\Plataforma\Datos.xlsm"
'declarar las variables
Dim rngToFilter As Range
Dim FindRow As Range
Dim LastRow As Integer
Dim cRow As String
Dim Datos As Worksheet
Set Datos = Workbooks.Open(DATA).Worksheets("Datos")
'Aplica la liberaci?n de las hojas para consultarlas
'SheetProtection
'Si hay filtros, los elimina de la hoja Datos
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
'Windows("Datos.xlsm").Visible = False 'Hace que no se muestre el excel externo (Datos)
'Makes external excel not show (Data)
'hold in memory and stop screen flicker
'Application.ScreenUpdating = False
If Me.bLeg3 <> "" And Me.bApe3 <> "" Then
' Please, enter a File or a Last Name
MsgBox "Por favor, ingresar un Legajo o un Apellido"
Exit Sub
End If
'error block
On Error GoTo errHandler:
'Filtrar solo por Legajo
If Me.bLeg3 <> "" Then
'Guardar el legajo en una variable
cRow = Me.bLeg3.Value
LastRow = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
Set rngToFilter = Worksheets("Datos").Range("A1:A" & LastRow)
'Filtrar solo por Apellido
ElseIf Me.bApe3 <> "" Then
'Encontrar la fila con la data
cRow = Me.bApe3.Value
LastRow = Sheets("Datos").Range("B" & Rows.Count).End(xlUp).Row
Set rngToFilter = Worksheets("Datos").Range("B1:B" & LastRow)
End If
' count filtered rows
rngToFilter.AutoFilter Field:=1, Criteria1:=cRow
Reg2.Value = rngToFilter.SpecialCells(xlCellTypeVisible).Cells.Count - 1
Set FindRow = rngToFilter.Find(What:=cRow, LookIn:=xlValues)
Me.CurrentAddress = FindRow.Address 'te trae la celda actual
'agregar los valores a las casillas correspondientes
Call SheetToForm(FindRow)
'error block
On Error GoTo 0
Exit Sub
errHandler:
' Verify the data entered, because they are not correct
MsgBox "Error! Verificar los datos ingresados, porque no son correctos!" & vbCrLf & Err.Description
End Sub
Sub SheetToForm(rng As Range)
Dim map As Variant, i As Integer
map = Array(0, "Leg3", 1, "Ape3", 2, "Nomb3", 3, "Pues3", _
4, "Fech3", 5, "ComboLiqui3", 6, "FechaDesde3", 7, "FechaHasta3", _
8, "Cant3", 9, "Obs3", 12, "Dia3", 13, "Dia4")
For i = LBound(map) To UBound(map) Step 2
Me.Controls(map(i + 1)).Value = rng.Columns(1).Offset(0, map(i))
Next
Me.CurrentAddress = rng.Address 'te trae la celda actual
End Sub
我有一个工作簿，每次打开它时，都会从它所拥有的任何过滤器中清除该工作簿，它可以正常工作。但是我想这样实现，每次完成搜索时，都会清除应用于该工作簿的过滤器。它给了我一个我无法解决的错误。
我也尝试过 If Sheets("Datos").AutoFilterMode then Sheets("Datos").AutoFilterMode = False 但又出现了另一个错误。
此外，每次激活第二个 if 时，应填充按姓氏过滤的总行数的文本框不会显示任何内容，但在应用第一个 if 时会显示任何内容，即用户 ID。 （如果需要问其他话题，就省略这一段）
Private Sub btnBuscar4_Click()
'declarar las variables
Dim FindRow
Dim LastRow As Integer, i As Integer
Dim cRow As String
Dim Datos As Worksheet: Set Datos = Workbooks.Open("C:\Users\Bonito\Desktop\Plataforma\Datos.xlsm").Worksheets("Datos")
'Aplica la liberación de las hojas para consultarlas
SheetProtection
'Si hay filtros, los elimina de la hoja Datos
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
'Windows("Datos.xlsm").Visible = False 'Hace que no se muestre el excel externo (Datos)
'hold in memory and stop screen flicker
'Application.ScreenUpdating = False
'error block
On Error GoTo errHandler:
'Filtrar solo por Legajo
If Me.BLeg3 <> "" Then
'Guardar el legajo en una variable
cRow = Me.BLeg3.Value
Worksheets("Datos").Range("A:A").AutoFilter Field:=1, Criteria1:=cRow
LastRow = Sheets("Datos").Range("A500").End(xlUp).Row - 1 'Hay que restarle uno para sacar el titulo
For i = 2 To LastRow
If Cells(i, 1) = cRow Then
Reg2.Value = LastRow 'Muestra la cantidad de filas filtradas de ese legajo
End If
Next i
'Encontrar la fila con la data
Set FindRow = Datos.Range("A:A").Find(What:=cRow, LookIn:=xlValues)
Me.CurrentAddress = FindRow.Address 'te trae la celda actual
'agregar los valores a las casillas correspondientes
Leg3.Value = FindRow
Fech3.Value = FindRow.Offset(0, 4)
Ape3.Value = FindRow.Offset(0, 1)
Nomb3.Value = FindRow.Offset(0, 2)
Pues3.Value = FindRow.Offset(0, 3)
ComboLiqui3.Value = FindRow.Offset(0, 5)
FechaDesde3.Value = FindRow.Offset(0, 6)
FechaHasta3.Value = FindRow.Offset(0, 7)
Dia3.Value = FindRow.Offset(0, 12)
Dia4.Value = FindRow.Offset(0, 13)
Cant3.Value = FindRow.Offset(0, 8)
Obs3.Value = FindRow.Offset(0, 9)
'Filtrar solo por Apellido
ElseIf Me.BApe3 <> "" Then
'Encontrar la fila con la data
cRow = Me.BApe3.Value
Worksheets("Datos").Range("B:B").AutoFilter Field:=1, Criteria1:=cRow
LastRow = Sheets("Datos").Range("B500").End(xlUp).Row - 1 'Hay que restarle uno para sacar el titulo / Se va hasta la ultima row y automaticamente sube al comienzo
For i = 2 To LastRow
If Cells(i, 1) = cRow Then
Reg2.Value = LastRow 'Muestra la cantidad de filas filtradas de ese legajo
End If
Next i
Set FindRow = Datos.Range("B:B").Find(What:=cRow, LookIn:=xlValues)
Me.CurrentAddress = FindRow.Address 'te trae la celda actual
'agregar los valores a las casillas correspondientes
Leg3.Value = FindRow.Offset(0, -1)
Fech3.Value = FindRow.Offset(0, 3)
Ape3.Value = FindRow
Nomb3.Value = FindRow.Offset(0, 1)
Pues3.Value = FindRow.Offset(0, 2)
ComboLiqui3.Value = FindRow.Offset(0, 4)
FechaDesde3.Value = FindRow.Offset(0, 5)
FechaHasta3.Value = FindRow.Offset(0, 6)
Dia3.Value = FindRow.Offset(0, 11)
Dia4.Value = FindRow.Offset(0, 12)
Cant3.Value = FindRow.Offset(0, 7)
Obs3.Value = FindRow.Offset(0, 8)
Else
MsgBox "Por favor, ingresar un Legajo o un Apellido"
End If
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "Error! Verificar los datos ingresados, porque no son correctos!" & vbCrLf & Err.Description
End Sub
您无法使用 End(xlUp).Row 计算筛选的行数。您需要使用 SpecialCells(xlCellTypeVisible).Cells.Count。我不明白过滤器的问题，因为它对我有用。尝试
Private Sub btnBuscar4_Click()
Const DATA = "C:\Users\Bonito\Desktop\Plataforma\Datos.xlsm"
'declarar las variables
Dim rngToFilter As Range
Dim FindRow As Range
Dim LastRow As Integer
Dim cRow As String
Dim Datos As Worksheet
Set Datos = Workbooks.Open(DATA).Worksheets("Datos")
'Aplica la liberaci?n de las hojas para consultarlas
'SheetProtection
'Si hay filtros, los elimina de la hoja Datos
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
'Windows("Datos.xlsm").Visible = False 'Hace que no se muestre el excel externo (Datos)
'Makes external excel not show (Data)
'hold in memory and stop screen flicker
'Application.ScreenUpdating = False
If Me.bLeg3 <> "" And Me.bApe3 <> "" Then
' Please, enter a File or a Last Name
MsgBox "Por favor, ingresar un Legajo o un Apellido"
Exit Sub
End If
'error block
On Error GoTo errHandler:
'Filtrar solo por Legajo
If Me.bLeg3 <> "" Then
'Guardar el legajo en una variable
cRow = Me.bLeg3.Value
LastRow = Sheets("Datos").Range("A" & Rows.Count).End(xlUp).Row
Set rngToFilter = Worksheets("Datos").Range("A1:A" & LastRow)
'Filtrar solo por Apellido
ElseIf Me.bApe3 <> "" Then
'Encontrar la fila con la data
cRow = Me.bApe3.Value
LastRow = Sheets("Datos").Range("B" & Rows.Count).End(xlUp).Row
Set rngToFilter = Worksheets("Datos").Range("B1:B" & LastRow)
End If
' count filtered rows
rngToFilter.AutoFilter Field:=1, Criteria1:=cRow
Reg2.Value = rngToFilter.SpecialCells(xlCellTypeVisible).Cells.Count - 1
Set FindRow = rngToFilter.Find(What:=cRow, LookIn:=xlValues)
Me.CurrentAddress = FindRow.Address 'te trae la celda actual
'agregar los valores a las casillas correspondientes
Call SheetToForm(FindRow)
'error block
On Error GoTo 0
Exit Sub
errHandler:
' Verify the data entered, because they are not correct
MsgBox "Error! Verificar los datos ingresados, porque no son correctos!" & vbCrLf & Err.Description
End Sub
Sub SheetToForm(rng As Range)
Dim map As Variant, i As Integer
map = Array(0, "Leg3", 1, "Ape3", 2, "Nomb3", 3, "Pues3", _
4, "Fech3", 5, "ComboLiqui3", 6, "FechaDesde3", 7, "FechaHasta3", _
8, "Cant3", 9, "Obs3", 12, "Dia3", 13, "Dia4")
For i = LBound(map) To UBound(map) Step 2
Me.Controls(map(i + 1)).Value = rng.Columns(1).Offset(0, map(i))
Next
Me.CurrentAddress = rng.Address 'te trae la celda actual
End Sub