Автофильтр без ошибки «Возобновить дальше»

У меня есть две таблицы на отдельных листах, я перебираю одну таблицу, чтобы выполнить некоторую обработку на другой таблице.

Dim shPoints As Worksheet
Dim shEmployees As Worksheet
Dim rngPoints As Range 
Dim rngEmployee As Range

Dim strEUID as String ' Stores the Employee ID
Dim intRow as Integer ' Current row

Set shEmployees = ThisWorkbook.Sheets("Employees")
Set rngEmployee = shEmployees.Range("tblEmployees")
Set shPoints = ThisWorkbook.Sheets("Points")
Set rngPoints = shPoints.Range("tblPoints")

shEmployee.AutoFilterMode = False
shPoints.AutoFilterMode = False

' On Error Resume Next  ' Works with this turned on
For intRow = 1 To shEmployee.Range("tblEmployees").Rows.Count
    strEUID = shEmployees.Range("tblEmployees[EUID]").Cells(intRow)

    rngPoints.AutoFilter Field:=1, Criteria1:=strEUID
    ' The filter above produces empty results occasionally because some employees do not have any points.
    ' Next line error "No cells were found"
    If shPoints.Range("tblPoints").SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
        ' Do stuff
    End If

Next intRow

У меня есть таблица сотрудников, которую я собираюсь повторить, чтобы выполнить некоторые вычисления, чтобы отслеживать вхождения сотрудников для отслеживания системы баллов. Если я добавлю «При ошибке возобновить дальше», код работает для сотрудников, у которых действительно есть события. Для сотрудников с чистой заявкой в ​​следующей строке выдается сообщение «Ячейки не найдены». Я нашел различные решения в Интернете, в том числе одно на этом сайте но ни один не работал.

Изменить: я заменил обходной путь, но все же очень хотел бы знать, можно ли обработать эту ошибку «Ячейки не найдены» без возобновления при ошибке «Далее». Обходной путь заключается в использовании функции countif, которая ищет в таблице Occurences идентификатор сотрудников в таблице Employees, если счетчик равен нулю, он пропускает его.

If shPoints.Application.CountIf(Range("tblPoints[EUID]"), strEUID) > 0 Then
    'Do Stuff
End If

person Lucretius    schedule 10.07.2014    source источник
comment
Я не вижу нигде в вашем коде установки значения для strEUID, тогда ваш код фактически Criteria1:=""   -  person PatricK    schedule 11.07.2014
comment
Спасибо, PatricK, я добавлю это через несколько. Честно говоря, я вырезал много шума, который, как я думаю, не поможет решить проблему. strEUID настраивается на каждой итерации таблицы сотрудников.   -  person Lucretius    schedule 11.07.2014
comment
Попробуйте Set rng = shPoints.Range("tblPoints").SpecialCells(xlCellTypeVisible) If rng Is Nothing Then ... Else ... End If   -  person Tony Dallimore    schedule 12.07.2014
comment
Согласен с @TonyDallimore, поскольку, если ничего не будет найдено, вызов метода .Rows приведет к ошибке. Вы также должны strEUID = shEmployees.Range("tblEmployees[EUID]").Cells(intRow).Value даже если это делается в фоновом режиме.   -  person PatricK    schedule 13.07.2014


Ответы (1)


Ответ на вопрос если эта ошибка "Ячейки не найдены" может быть обработана без возобновления при ошибке "Далее". - НЕТ.

Именно так работает SpecialCells.

Общая форма

Sub Demo()
    Dim rFiltered As Range

    '...
    ' Other code
    '...

    Set rFiltered = Nothing
    On Error Resume Next
    Set rFiltered = YourRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0 ' or use your own error handler
    If Not rFiltered Is Nothing Then
        ' Process filtered list
    End If

    '...
    ' Other code
    '...

End Sub
person chris neilsen    schedule 11.12.2015