Количество отфильтрованных строк и количество отображаемых - PullRequest
0 голосов
/ 14 февраля 2019

Я хочу отфильтровать по трем критериям, подсчитать количество фильтруемых строк, вывести количество в ячейке N2, а затем удалить отфильтрованные строки.Я не уверен, почему мой код ниже не работает.

Sheets("Sheet1").Range("B4").Select
Sheets("Sheet1").Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter Field:=8, Criteria1:=Array("A", "B", "C"), Operator:=xlFilterValues
Selection.Cell("N1").Select
ActiveCell.Value = Range(Cells(1, 1), Cells(Selection.SpecialCells(xlcelltypelast).Row, Selection.SpecialCells(xlCellTypeLastCell).Column)).Count
Selection.AutoFilter

1 Ответ

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

Представьте себе эти данные

enter image description here

  • Прежде всего вам следует избегать использования Select в Excel VBA .

  • Также не существует ни xlLastCell, ни xlcelltypelast, вы, вероятно, имели в виду xlCellTypeLastCell Я рекомендую активировать Option Explicit, чтобы избежать таких опечаток: В редакторе VBA перейдите на Инструменты Параметры Требуется объявление переменной .

  • Отфильтрованные данные могут не быть непрерывным диапазономно разделены на разные области.

    enter image description here

    Так что FilterRange.SpecialCells(xlCellTypeVisible).Rows.Count даст вам только количество строк в первой области.Таким образом, вы должны пройтись по областям For Each iArea In FilterRange.SpecialCells(xlCellTypeVisible).Areas и суммировать .Rows.Count, чтобы получить их общее количество.

    Окончательный результат после удаления:
    enter image description here


Option Explicit

Sub FilterAndDelete()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim FilterRange As Range
    Set FilterRange = ws.Range(ws.Range("B4"), ws.Range("B4").SpecialCells(xlCellTypeLastCell))

    FilterRange.AutoFilter Field:=8, Criteria1:=Array("A", "B", "C"), Operator:=xlFilterValues

    Dim RowCount As Long

    Dim iArea As Range
    For Each iArea In FilterRange.SpecialCells(xlCellTypeVisible).Areas
        RowCount = RowCount + iArea.Rows.Count
    Next iArea

    ws.Range("N2").Value = RowCount - 1 'subtract header

    'delete rows but keep header
    Dim RowsToDelete As Range
    On Error Resume Next 'next line throws error if filter is empty. Hide it.
    Set RowsToDelete = FilterRange.Resize(RowSize:=FilterRange.Rows.Count - 1).Offset(RowOffset:=1).SpecialCells(xlCellTypeVisible)
            'This Part FilterRange.Resize(RowSize:=FilterRange.Rows.Count - 1).Offset(RowOffset:=1) excludes the header from the FilterRange (we don't want to delete that).
    On Error GoTo 0 'always re-activate error reporting!
    If Not RowsToDelete Is Nothing Then
        RowsToDelete.EntireRow.Delete
    End If
    FilterRange.AutoFilter
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...