VBA фильтр нескольких столбцов одновременно

Question

Джим Л из Онтарио оказал огромную помощь в решении моей первой задачи. Вы можете просмотреть это по этой ссылке: Предыдущее обсуждение

Я подумал, что было бы просто добавить фильтры для дополнительных столбцов после того, как вопрос о фильтре даты был решен. Нет.

Я пытался добавить дополнительные фильтры в тех же пределах, что и фильтр DATE ... Я пытался добавить дополнительные фильтры в том же подпункте, но под фильтром DATE ... даже помещая дополнительные фильтры в отдельных сабах. Ничего не работает.

Пример рабочей книги можно скачать здесь: Скачать рабочую книгу

Конечным пользователям потребуется фильтровать по одному или нескольким столбцам одновременно. , Как я могу работать с существующим кодом в рабочей книге?

Я в тупике!

Спасибо.

Answer 1

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

COL_FILTER - это целочисленный параметр для sub filterCol, который является общим c для всех столбцов, в которые вы хотите добавить фильтр ( кроме даты, которая является частным случаем). Назначьте кнопку фильтра «UNIT» для дополнительного фильтра B, кнопку «Call RCVD» для дополнительного фильтра C et c. При первом нажатии любой кнопки раскрывающиеся списки фильтров отображаются во всех столбцах, но только к одному столбцу будут применяться критерии. Нажатие дополнительных кнопок установит критерии для этих дополнительных столбцов и сохранит предыдущие фильтры. Ввод пустого условия поиска приведет к удалению критериев только для этого столбца

Option Explicit

Sub ResetFilters()
    Dim Wks As Worksheet
    Set Wks = Sheets("Call Log File")
    With Wks
        On Error Resume Next
        If Wks.AutoFilterMode Then
            Wks.AutoFilterMode = False
        End If
    End With
End Sub

Sub FilterB()
    Call filterCol(2)
End Sub

Sub FilterC()
    Call filterCol(3)
End Sub

Sub filterCol(COL_FILTER As Integer)

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Call Log File")

    ' set auto filter to all columns if not already on
    Dim rngFilter As Range
    Set rngFilter = ws.Range("A2:K2")
    If ws.AutoFilterMode = False Then
        rngFilter.AutoFilter
    End If
    'Debug.Print rngFilter.Address

    ' get filter criteria
    Dim sColname As String
    sColname = ws.Cells(2, COL_FILTER)
    Dim sPrompt As String, sUserInput As String, n As Integer
    sPrompt = "Enter " & sColname
    sUserInput = InputBox$(sPrompt)

    Dim criteria(2) As String
    criteria(1) = "*" & sUserInput & "*"

    ' apply filter to the select column
    If ws.AutoFilterMode = True Then
        rngFilter.AutoFilter COL_FILTER, "=" & criteria(1)
    End If

End Sub


Sub FilterDate()

    Const COL_FILTER As Integer = 1 ' A

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Call Log File")

    ' set auto filter to all columns if not already on
    Dim rngFilter As Range
    Set rngFilter = ws.Range("A2:K2")
    If ws.AutoFilterMode = False Then
        rngFilter.AutoFilter
    End If
    'Debug.Print rngFilter.Address

    Dim sPrompt As String, sUserInput As String, n As Integer
    sPrompt = "Enter DATE" & vbCrLf & _
    "For YEAR ONLY: YY" & vbCrLf & _
    "For YEAR & MONTH: YYMM" & vbCrLf & _
    "For YEAR & MONTH & DAY: YYMMDD"

    sUserInput = InputBox$(sPrompt)
    n = Len(sUserInput)
    If n = 0 Then
      rngFilter.AutoFilter COL_FILTER ' clear filter
      Exit Sub
    ElseIf Not (n = 2 Or n = 4 Or n = 6) Then
      MsgBox sUserInput & " is not correct", vbExclamation, "Wrong Format"
      Exit Sub
    End If

    Dim mydate As Variant
    mydate = dateRange(sUserInput)
    'Debug.Print sUserInput, mydate(1), mydate(2)

    If ws.AutoFilterMode = True Then
       rngFilter.AutoFilter COL_FILTER, ">=" & mydate(1), 1, "<=" & mydate(2)
    End If

End Sub

Function dateRange(s As String)
   Dim s1 As String, s2 As String
   s1 = "000"
   s2 = "999"
   Select Case Len(s)
     Case 2
       s1 = "0101" & s1
       s2 = "1231" & s2
     Case 4
       s1 = "01" & s1
       s2 = "31" & s2
     Case 6
       ' nothing to add
     Case Else
       dateRange = ""
       Exit Function
   End Select
   Dim rng(2) As Long
   rng(1) = CLng(s + s1)
   rng(2) = CLng(s + s2)
   dateRange = rng
End Function

Answer 2

Для пользы других ... этот следующий макрос будет искать термин в столбце B, после того как таблица отфильтрована столбцом A. Хотя это не «подход фильтрации» в столбце B, он очень эффективен и делает именно то, что я искал.

Спасибо всем за вашу помощь.

Sub FilterB()
Dim cl As Range, rng As Range
Dim sPrompt As String, sUserInput As String

Set rng = Range("B3:B100")

sPrompt = "Enter SEARCH TERM"
sUserInput = InputBox$(sPrompt)

For Each cl In rng.SpecialCells(xlCellTypeVisible)
    If cl.Value <> sUserInput Then
        cl.Rows.Hidden = True
    End If
Next cl

End Sub

И это может быть продублировано столько раз, сколько требуется для далее «отфильтровываю» дополнительные столбцы.