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

Question

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

我想在生成的报告中获取与每个关键字关联的列的总和

但是，报告可能包含也可能不包含全部五个关键字；每天可能会有所不同，例如有或没有黄色

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

但是一旦我搜索第二个关键字，就会发生错误：这不能​​应用于单个单元格，请选择一个范围内的单个单元格（运行时错误 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

这里有很多问题。

1. 使用Select 会产生意外结果（第二个过滤器将应用于Windows("Book6")）。使用变量来引用工作表和范围。
2. 重置自动过滤器很脆弱，如果不存在，它实际上会设置一个过滤器。在清除之前检测过滤器是否存在。
3. 清理范围选择。
4. 第二个过滤器后缺少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 应用到的范围包括标题行，并且 AutoFilter 永远不会隐藏标题，所以在这种情况下 SpecialCells 将始终返回一个 result 。

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

结束子