Автофильтр всех столбцов после каждого поиска / пользовательской формы VBA - PullRequest
0 голосов
/ 13 марта 2020

У меня есть рабочая книга, которая при каждом открытии очищает рабочую книгу от любого фильтра, который у него есть, и с которым он работает. Но я хочу реализовать это так, что каждый раз, когда выполняется поиск, фильтр, примененный к этой книге, очищается. Это дает мне ошибку, которую я не могу решить.

Я пытался также сделать If Sheets("Datos").AutoFilterMode then Sheets("Datos").AutoFilterMode = False, но дает мне еще одну ошибку.

Далее, каждый раз, когда активируется секунда, если она активируется, Текстовое поле, которое должно заполнить общее количество строк, отфильтрованных по фамилии, ничего не показывает, но показывает, когда применяет первый if, который является идентификатором пользователя. (Если его нужно спросить на другом топи c, просто пропустите этот параграф)

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

1 Ответ

1 голос
/ 13 марта 2020

Вы не можете сосчитать количество отфильтрованных строк с помощью 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
...