如何过滤VBA中的关键字，包括可能找不到的关键字？

Question

我想过滤 B 列中可能有或没有五个关键字（红色、蓝色、橙色、绿色和黄色）的报告，这些关键字与不同列中的数字相关联

我想对生成的报告中与每个关键字关联的列求和

但是，报告可能包含也可能不包含所有五个关键字；日复一日可能会有所不同，例如有或没有黄色

我将 C 列中第一个关键字（一个标准）的总和粘贴到其他地方，它起作用了！

但是一旦我搜索第二个关键字，就会发生错误：这不能应用于单个单元格，select 范围内的单个单元格（运行-时间错误 1004） .有什么想法吗？

第二个问题是如何设置我的范围 (C2:C1000) 和 (B2:B1000) 以及 C 列中的所有过滤数字和 B 列中的关键字，因为我可以有超过 1000 行或行的位置是超过 1000

Set rng = ws.Range("C1:C" & lastrow) 'but to no avail

Sub filterVBA()
    Dim lastrow As Long
    Dim visibleTotal As Long
    Dim ws As Worksheet
    Dim rng As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set rng = ws.Range("C2:C1000")

    Columns("B:B").Select
    Selection.AutoFilter
    ActiveSheet.Range("B2:B1000").AutoFilter Field:=1, Criteria1:="red"

    visibleTotal = Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible))

    Windows("Book6").Activate
    Range("A1").Value = visibleTotal

    Columns("B:B").Select
    Selection.AutoFilter
    ActiveSheet.Range("B2:B1000").AutoFilter Field:=1, Criteria1:="blue"

    Windows("Book6").Activate
    Range("A2").Value = visibleTotal
End Sub

Answer 1

这里有很多问题。

使用 Select 会产生意想不到的结果（第二个过滤器将应用于 Windows("Book6")）。使用变量引用工作表和范围。
重置自动过滤器很脆弱，如果一个不存在，它实际上会设置一个过滤器。在清除之前检测过滤器是否存在。
清理范围选择。
第二次筛选后缺少 visibleTotal =

Sub filterVBA()
    Dim visibleTotal As Long
    Dim wsTable As Worksheet
    Dim wsReport As Worksheet
    Dim rTable As Range
    Dim rReport As Range

    'Get reference to Table
    Set wsTable = ThisWorkbook.Sheets("Sheet1")
    With wsTable
        Set rTable = .Range("B2", .Cells(.Rows.Count, "C").End(xlUp))
    End With

    'Get Reference to Reult sheet
    Set wsReport = Application.Workbooks("Book6").ActiveSheet
    Set rReport = wsReport.Cells(1, 1)

    'Clear Filter if it exists
    If wsTable.AutoFilterMode Then
        rTable.AutoFilter
    End If
    'Set Filter
    rTable.AutoFilter Field:=1, Criteria1:="red"

    visibleTotal = Application.WorksheetFunction.Sum(rTable.Columns(2).SpecialCells(xlCellTypeVisible))
    'Alternative formula
    'visibleTotal = Application.WorksheetFunction.Subtotal(109, rTable.Columns(2))

    'Report result
    rReport.Value = visibleTotal
    Set rReport = rReport.Offset(1, 0)

    'Next Filter
    rTable.AutoFilter Field:=1, Criteria1:="white"
    visibleTotal = Application.WorksheetFunction.Sum(rTable.Columns(2).SpecialCells(xlCellTypeVisible))

    rReport.Value = visibleTotal
    Set rReport = rReport.Offset(1, 0)
End Sub

_{注意为什么 SpecialCells 周围没有错误处理}

_{因为应用 SpecialCells 的范围包括 header 行，并且自动筛选从不隐藏 header，在这种情况下 SpecialCells 将始终是 return 结果。}

Answer 2

感谢您的反馈克里斯

我得到的答案看起来像这样并且效果很好：

子过滤器VBA()

 Dim rng As Range
 Dim ws As Worksheet
 Dim visibleTotal As Long


 Set ws = ThisWorkbook.Sheets(1)
 Set rng = ws.Range("D:D")

 If ws.FilterMode = True Then
         ws.ShowAllData
 End If


 Application.ScreenUpdating = False


 ws.Range("C:C").AutoFilter Field:=1, Criteria1:="Yellow"


 visibleTotal = Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible))

 Windows("Book6").Activate
 Range("A1").Value = visibleTotal



 ws.Range("C:C").AutoFilter Field:=1, Criteria1:="Red"
 visibleTotal = Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible))

 Windows("Book6").Activate
 Range("A5").Value = visibleTotal


 ws.Range("C:C").AutoFilter Field:=1, Criteria1:="Green"
 visibleTotal = Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible))

 Windows("Book6").Activate
 Range("A10").Value = visibleTotal


 ws.Range("C:C").AutoFilter Field:=1, Criteria1:="Blue"
 visibleTotal = Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible))

 Windows("Book6").Activate
 Range("A15").Value = visibleTotal


 If ws.FilterMode = True Then
         ws.ShowAllData
 End If

 Application.ScreenUpdating = True

结束子

如何过滤VBA中的关键字，包括可能找不到的关键字？

How to filter keywords in VBA, including keywords that may not be found?

excel

vba

criteria

filter