vba - 如何使用不同列上的另一个自动过滤器循环过滤范围？

Question

我在 F 列上应用了基于条件 (>1) rng.AutoFilter Field:=6, Criteria1:=">1" 的过滤器，其中 rng 是通过 VBA 设置数据的早些时候。

现在，我想从过滤后的行中对 Col E (5) 应用另一个过滤器，并循环遍历 Col E 中的每个唯一可见值，并对数据执行一些比较，并确定是保留它还是删除这些行 -但我不知道会显示什么值 - 这取决于第一个过滤器 - 我该如何实现这一点？

这是到目前为止的完整代码:

Sub CashFlowReporting()

Dim Dest, Source As Workbook
Dim DestCell As Range
Dim sh, ws, data As Worksheet
Dim x, y, r, c, m, s As Integer
Dim fname, sname, txt As String
Dim starttime, endtime, dtDate As Date
Dim ans As VbMsgBoxResult
Dim rng, rng1 As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

starttime = Now
fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm", Title:="Select the Term Changes Query Results file.")
If fname = False Then Exit Sub

ans = MsgBox("Is " & fname & "the Term Changes Query Results excel file?", vbYesNo)

If ans = vbYes Then
    Workbooks.Open Filename:=fname
Else
    MsgBox ("Please run the cash flow report genrator again and select the query results file.")
    Exit Sub
End If

Set Source = ActiveWorkbook
Set sh = ActiveSheet

sh.Range("E:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Value = "Number_Site"
Range("F1").Value = "Count Num_Site"

Range("E2").FormulaR1C1 = "=RC[-3]&RC[-1]"
r = Range("A1").End(xlDown).Row
Range("E2", Cells(r, "E")).FillDown
Columns("E:F").AutoFit

Set rng = Range("A1")
Set rng = Range(rng, rng.End(xlToRight))
Set rng = Range(rng, rng.End(xlDown))
rng.Name = "Data"

Range("A2", Range("A2").End(xlDown)).Name = "Date"
Range("E2", Range("E2").End(xlDown)).Name = "Num_site"

sh.Sort.SortFields.Clear
sh.Sort.SortFields.Add Key:=Range("Num_site") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
sh.Sort.SortFields.Add Key:=Range("Date") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With sh.Sort
    .SetRange Range("Data")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Range("F2").Formula = "=countif($E$2:$E$1000,E2)"
Range("F2", Cells(r, "F")).FillDown

rng.AutoFilter field:=6, Criteria1:=">1"
Set rng1 = rng.Rows.SpecialCells(xlCellTypeVisible)
rng1.Select

我现在想要根据字段 5 进行过滤，但针对该字段中的每个唯一值(循环遍历它 - 在本例中只有 2 - 可能更多)

这里是在 F 列应用第一个过滤器的数据屏幕截图的链接，现在我想根据此过滤器循环浏览 E 列中的 2 个唯一值(在本例中):

如果有比过滤器更优雅的解决方案，那么我对此持开放态度 - 我已经尝试过数据透视和高级过滤器，但无法找到解决方案。

提前致谢，感谢所有帮助。

Answer 1

虽然 Scripting.Dictionary 可能会使查找唯一值变得更容易，但只需要几行额外代码即可复制字典的 Exists 功能。

Dim rng As Range, ctv As Range, f As Long, vFLTR As Variant

vFLTR = ChrW(8203)

With ActiveSheet   'set this worksheet reference properly!
    If .AutoFilterMode Then .AutoFilterMode = False
    Set rng = .Cells(1, 1).CurrentRegion

    With rng
        .AutoFilter Field:=6, Criteria1:=">1"
        If Application.Subtotal(103, .Columns(5)) > 1 Then
            With rng.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
                For Each ctv In .Columns(5).Cells.SpecialCells(xlCellTypeVisible)
                    If Not CBool(InStr(1, vFLTR, ChrW(8203) & ctv.Value & ChrW(8203), vbTextCompare)) Then
                        vFLTR = vFLTR & ctv.Value & ChrW(8203)
                    End If
                Next ctv
                vFLTR = Left(vFLTR, Len(vFLTR) - 1): vFLTR = Right(vFLTR, Len(vFLTR) - 1)
                vFLTR = Split(vFLTR, ChrW(8203))
            End With
            For f = LBound(vFLTR) To UBound(vFLTR)
                .AutoFilter Field:=5, Criteria1:=vFLTR(f)
                MsgBox "pause and look"
                .AutoFilter Field:=5
            Next f
        End If
        .AutoFilter
    End With
End With

我在等待您提供它所属的框架时写道，但您当然可以看到首先收集一组唯一的可见值，然后循环遍历它们以获取附加过滤列的过程。