Расширенный фильтр Excel, не возвращающий никаких данных - PullRequest
0 голосов
/ 09 мая 2018

Попытка получить рабочий фильтр для быстрого построения отчета - как видно здесь .

Мой код на данный момент выглядит так:

Option Explicit
Sub GetData()

'Clear data field

    Sheets("Filter").Select
    Range("B10").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Clear

'Advanced Filter code

    Sheets("RawData").Range("JobRegister[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("RawData").Range("W1:AA2"), CopyToRange:=Sheets("Filter").Range("B10:T10"), Unique:=True



    Range("B10").Select

End Sub

И он возвращает только заголовки столбцов и никаких результатов, независимо от того, что я использую в качестве критерия.

Фильтры моих критериев выглядят так:

=IF(Filter!C4="Any","",Filter!C4)

Где C4 содержит список DV, взятый из другого листа.

У меня было вроде как работать временно (это отфильтровывало бы по некоторым критериям, а не по другим), но я не знаю, что именно я сделал, чтобы заставить его работать, и почему он больше не работает!

1 Ответ

0 голосов
/ 10 мая 2018

Если код возвращает только заголовки, это означает, что у вас есть одна из этих проблем.

  1. У вас нет соответствующих данных в соответствии с критериями, установленными в диапазоне Sheets("RawData").Range("W1:AA2"). Вручную проверьте эти критерии в наборе данных и посмотрите, не найдены ли подходящие строки.
  2. И если вы найдете несколько подходящих строк, должна быть проблема с заголовками, которые вы указали в диапазоне W1:AA1 на листе RawData. Заголовки в диапазоне критериев должны совпадать с заголовками в наборе данных . Проверьте также наличие пробелов в начале или в конце.

Отредактированный код:

Вот отредактированный код. Пожалуйста, попробуйте ...

Sub GetData()
Dim sws As Worksheet, dws As Worksheet

Application.ScreenUpdating = False

Set sws = Sheets("RawData")
Set dws = Sheets("Filter")

'Clearing the Criteria Range
sws.Range("W2:AA2").ClearContents

If dws.Range("C3") = "" Or dws.Range("C3").Value = "Any" Then
    sws.Range("X2").Value = ""
Else
    sws.Range("X2").Value = dws.Range("C3").Value
End If

If dws.Range("C4") = "" Or dws.Range("C4").Value = "Any" Then
    sws.Range("Z2").Value = ""
Else
    sws.Range("Z2").Value = dws.Range("C4").Value
End If

If dws.Range("C5") = "" Or dws.Range("C5").Value = "Any" Then
    sws.Range("Y2").Value = ""
Else
    sws.Range("Y2").Value = dws.Range("C5").Value
End If

If dws.Range("C6") = "" Or dws.Range("C6").Value = "Any" Then
    sws.Range("AA2").Value = ""
Else
    sws.Range("AA2").Value = dws.Range("C6").Value
End If

If dws.Range("C7") = "" Or dws.Range("C7").Value = "Any" Then
    sws.Range("W2").Value = ""
Else
    sws.Range("W2").Value = dws.Range("C7").Value
End If


'Clear data field

dws.Range("B10").CurrentRegion.Clear

'Advanced Filter code
sws.Range("JobRegister[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    sws.Range("W1:AA2"), CopyToRange:=dws.Range("B10:T10"), Unique:=True

Application.ScreenUpdating = True
End Sub
...