Excel VBA автофильтр - PullRequest
       1

Excel VBA автофильтр

0 голосов
/ 11 февраля 2019

У меня есть база данных с заголовками, которая начинается со строки 2, а во второй строке заголовки и все остальные данные ниже.У меня есть 11 столбцов на нем.В первой строке это будет строка, в которой будет выполняться поиск ввода для автоматического фильтра, но я хочу сделать это только для некоторых столбцов.

Я просто хочу, чтобы ввод автоматического фильтра работал для столбца.E, F, H и I Все остальные входы не должны ничего делать.

Однако при попытке установить критерии множественных значений по отдельности автофильтр не работает, ничего не показывает.Он работает только тогда, когда я пишу что-то в столбце E, если я начинаю писать что-то в любом другом, он ничего не показывает

Красный фон должен быть ячейками, недоступными для редактирования Зеленый цвет должен быть ячейками, редактируемыми для поиска / фильтра

Кнопка 1 предназначена для добавления более способных строк, но пока я еще не выполнил эту часть, пытался выяснить, что делать на стороне фильтра

Это код, который у меня есть:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False

Dim sht As Worksheet
Dim LastRow As Long
Dim DataRange As Range

Set sht = ActiveSheet
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Set DataRange = Range("A3:J" & LastRow)

If Target.Row = 1 Then
    If Target.Column > 1 Then
        If Target.Column = 5 Then
            Cells(Target.Row, 6).NumberFormat = "0"

            Cells(Target.Row, 9).NumberFormat = "General"
            Cells(Target.Row, 9).Value = "Figueira da Foz"
        End If
    End If
    DataRange.AutoFilter Field:=1, VisibleDropDown:=False
    DataRange.AutoFilter Field:=2, VisibleDropDown:=False
    DataRange.AutoFilter Field:=3, VisibleDropDown:=False
    DataRange.AutoFilter Field:=4, VisibleDropDown:=False
    DataRange.AutoFilter Field:=5, Criteria1:="*" & Cells(Target.Row, 5).Value & "*", VisibleDropDown:=False
    DataRange.AutoFilter Field:=6, VisibleDropDown:=False
    DataRange.AutoFilter Field:=7, Criteria1:="*" & Cells(Target.Row, 7).Value & "*", VisibleDropDown:=False
    DataRange.AutoFilter Field:=8, Criteria1:="*" & Cells(Target.Row, 8).Value & "*", VisibleDropDown:=False
    DataRange.AutoFilter Field:=9, VisibleDropDown:=False
    If Target.Column = 10 Then
        If Target.Value = vbNullString Then
            DataRange.AutoFilter Field:=10, VisibleDropDown:=False
        Else
            DataRange.AutoFilter Field:=10, Criteria1:=Cells(Target.Row, 10).Value, VisibleDropDown:=False
        End If
    End If
End If
If Target.Row = 2 Then
    Range("A" & Target.Row & ":J" & Target.Row).Locked = True
End If
If Target.Row > 2 Then
    If Target.Column = 5 Then
        Cells(Target.Row, 1).NumberFormat = "0"
        Cells(Target.Row, 1).Value = Target.Row - 2

        Cells(Target.Row, 2).NumberFormat = "yyyy-mm-dd"
        Cells(Target.Row, 2).Value = Now

        Cells(Target.Row, 3).NumberFormat = "hh:mm"
        Cells(Target.Row, 3).Value = Now

        Cells(Target.Row, 6).NumberFormat = "0"

        Cells(Target.Row, 9).NumberFormat = "General"
        Cells(Target.Row, 9).Value = "Figueira da Foz"

        Cells(Target.Row, 10).NumberFormat = "General"
        Cells(Target.Row, 10).Value = "Activa"

        Range("A" & Target.Row & ":J" & Target.Row).Interior.ColorIndex = 4
    End If
    If Target.Column = 10 Then
        If Target.Value = "Inactiva" Then
            Cells(Target.Row, 4).NumberFormat = "hh:mm"
            Cells(Target.Row, 4).Value = Now
            Range("A" & Target.Row & ":J" & Target.Row).Interior.ColorIndex = 3
        End If
        If Target.Value = "Activa" Then
            Cells(Target.Row, 4).Value = vbNullString
            Range("A" & Target.Row & ":J" & Target.Row).Interior.ColorIndex = 4
        End If
        If Target.Value = vbNullString Then
            Range("A" & Target.Row & ":J" & Target.Row).Interior.ColorIndex = 2
        End If
    End If
End If

Application.DisplayAlerts = False
ThisWorkbook.Save
Application.EnableEvents = True
ActiveSheet.Protect
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...