应用过滤器后计算空白单元格

Question

这不是我的代码，因为有人在 stackflow 上帮助了我。但是我仍然坚持它所以再次发布。

本质上，代码对 E 列中的空白单元格进行计数，因此逻辑有效。但是，在计算空白单元格之前，我想从 H 列中排除“现金”。

下面是代码，它确实在 H 列（不包括现金）上应用过滤器，但是空白单元格被计算为包含现金的数据。

Sub exampleTHis()

    ActiveSheet.Range("H:H").AutoFilter Field:=8, Criteria1:="<>Cash", _
    Operator:=xlAnd

Dim ws As Worksheet, testRange As Range, aCount As Long, zAnswer

For Each ws In ThisWorkbook.Worksheets

Set testRange = Intersect(ws.Range("E:E"), ws.UsedRange)
 'Set testRange = ws.Range("E2", Range("E" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
 
    If Not testRange Is Nothing Then
        
        aCount = Application.WorksheetFunction.CountBlank(testRange)
        If aCount > 0 Then
         'blank cells found....
            zAnswer = MsgBox(aCount & " blank values found in at " & ws.Name & testRange.Address & ".  Continue macro?", vbYesNo)
            
            If zAnswer = vbNo Then Exit For
            
        End If
    End If
    
Next ws

End Sub
'''

Answer 1

使用 AutoFilter 和 SpecialCells 计算自动筛选列中的空白

• 为了能够在消息框中写入关键单元格的地址，复杂性是必需的。如果你只是在数数之后，你可以简化。

Sub CountBlanksInFilteredColumn()
    ' Not blank:           "<>"
    ' Blank:               "" or "=" (includes Empty)
    ' Blank but not empty: "<=>"
    ' Empty? Anybody?
    
    Const SHEET_NAME As String = "Assets"
    Const BLANK_COLUMN As Long = 5
    Const BLANK_CRITERION As String = ""
    Const CASH_COLUMN As Long = 8
    Const CASH_CRITERION As String = "<>Cash"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets(SHEET_NAME)
    
    Dim vrg As Range
    
    With ws
        If .FilterMode Then .ShowAllData ' clear filters
        Dim rg As Range: Set rg = ws.UsedRange
        With rg
            Dim crg As Range ' without header
            Set crg = .Columns(BLANK_COLUMN).Resize(.Rows.Count - 1).Offset(1)
            .AutoFilter BLANK_COLUMN, BLANK_CRITERION
            .AutoFilter CASH_COLUMN, CASH_CRITERION
            On Error Resume Next
                Set vrg = crg.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        .AutoFilterMode = False ' turn off auto filter
    End With
    
    Dim Blanks As Long, vrgAddress As String
    
    If Not vrg Is Nothing _
        Then Blanks = vrg.Cells.Count: vrgAddress = vrg.Address(0, 0)
    
    MsgBox "Found " & Blanks & " blank cell" _
        & IIf(Blanks = 1, "", "s") _
        & IIf(Blanks = 0, "", ":" & vbLf & vrgAddress) & ".", _
        IIf(Blanks = 0, vbExclamation, vbInformation)
    
End Sub